1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
|
MSCF0 ;MSC/REC ;AUTO FAXING; 14 JULY 2010 - 1414
;;1.5;AUTO FAX;**1502**;1/23/2008
;
Q:$$GET^XPAR("ALL","MSC AUTO FAX ON")<1 ; check auto fax parameter
S MSCAFMP=$$GET^XPAR("ALL","MSC AUTO FAX PRELIM MICROS")
Q:$G(DUZ(2))']"" ; no division
Q:$G(PKG)']"" ; no package designation
N MSCEXIT,MSG,%DT S MSCEXIT=0
D DEV I MSCEXIT D EXIT Q
D VAR I MSCEXIT D EXIT Q
D PROV ; get provider IEN
Q:MSCEXIT ; problem with getting provider IEN
D FAXINFO I MSCEXIT D EXIT Q
D MCD
D FAXED I MSCEXIT D EXIT Q
;
I PKG="LR" D
. D CHK I MSCEXIT Q
. D INTERIM^MSCF1
;
I PKG="RA" D
. D RADFAX^MSCFR1
;
D EXIT
Q
VAR ;
S PKG=$S(PKG["LR":PKG,PKG["LAB":"LR",PKG="RA":PKG,PKG["RAD":"RA",1:"")
I PKG="LR" D
. I $G(LRUID)']"" D
. . I $G(LRAA),$G(LRAD),$G(LRAN) S LRUID=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,.3),U)
. I $G(LRUID)']"" S MSCEXIT=1
I PKG="RA" D
. S MSCRAID=$P(^RARPT(RARPT,0),U)
. I $G(MSCRAID)']"" S MSCEXIT=1
Q
;
PROV ; get provider
I PKG="LR" D
. ;I '$G(LRPRAC) D
. ;. S LRPRAC=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,8)
. ;I LRPRAC'=+LRPRAC S MSCDOC=$O(^VA(200,"B",LRPRAC,0))
. I $G(LRODT)']""!($G(LRSN)']"") S MSCEXIT=1 Q ; no order date or specimen #. Need both to get ordering provider from file 69.
. S MSCDOC=$P(^LRO(69,LRODT,1,LRSN,0),U,6) ; ordering provider
. I $G(MSCDOC)']"",$G(LRPRAC) S MSCDOC=LRPRAC
. S MSCDOCNM=$P(^VA(200,MSCDOC,0),U)
. I $G(MSCDOCNM)']""!($G(MSCDOC)']"") S MSCEXIT=1
I PKG="RA" D
. N R3 S R3=$G(^RADPT(+$G(RADFN),"DT",+$G(RADTI),"P",+$G(RACNI),0))
. S MSCDOC=$P(R3,U,14) I 'MSCDOC S MSCEXIT=1 Q
. S MSCDOCNM=$P(^VA(200,MSCDOC,0),U) I MSCDOCNM']"" S MSCEXIT=1 Q
I $G(MSCDOC)]"" S MSCTVN=$$GET1^DIQ(200,MSCDOC_",",".132","","")
Q
FAXINFO ; get doc's fax info
N MSCFXI,MSCX
S MSCFXI=$O(^MSC(21463,"B",MSCDOC,0)) I $G(MSCFXI)']"" S MSCEXIT=1 Q
I '$D(^MSC(21463,MSCFXI)) S MSCEXIT=1 Q
S MSCX=^MSC(21463,MSCFXI,0)
I $P(MSCX,U,4) S MSCEXIT=1 Q
I PKG_"B"'[$P(MSCX,U,3) S MSCEXIT=1 Q ; not set to fax results
S MSCFAXNU=$P(MSCX,U,2)
Q
DEV ; get device info
I $$GET^XPAR("ALL","MSC AUTO FAX DEBUG ON") D HOME^%ZIS U IO S IOSL=55 Q
;
; Need to have a device in the device file called fax appliance!
I '$D(^%ZIS(1,"B","FAX APPLIANCE")) W !!!,"FAX APPLIANCE Device undefined. Contact IRM.",!!! S MSCEXIT=1
Q
;
FAXED ; check if fax already sent for LRUID. Only checking for "CH" subscripted results at this time.
N MSCLRT,MSCLRSB,MSCNOFAX S MSCNOFAX=1
I $G(LRSS)'="CH" Q
I $D(^MSC(21463.1,"LRUID",LRUID)) D I MSCNOFAX S MSCEXIT=1 Q
. N I S I=$O(^MSC(21463.1,"LRUID",LRUID,0)) I 'I S MSCNOFAX=0 Q
. N C S C=0 F S C=$O(LRSB(C)) Q:'C!('MSCNOFAX) D
. . S MSCTST=+$P(LRSB(C),"!",7)
. . N J S J=0 F S J=$O(^MSC(21463.1,I,60,J)) Q:'J!'MSCNOFAX D
. . . N MSCLRT S MSCLRT=+^MSC(21463.1,I,60,J,0)
. . . I MSCLRT'=MSCTST Q
. . . S MSCLRSB=$P($P(^LAB(60,MSCLRT,0),U,5),";",2)
. . . I $G(MSCLRSB)']"" Q
. . . S MSCNOFAX=$P(^MSC(21463.1,I,60,J,0),U,2)=$P(LRSB(MSCLRSB),U)
;
Q
;
MCD ; get medical center director
N MSCI S MSCI=0 F S MSCI=$O(^DIC(4,DUZ(2),2,MSCI)) Q:'MSCI D
. S (MCDIR,MCDPHONE)=""
. S MCDAREA=$P(^DIC(4,DUZ(2),2,MSCI,0),U,2)
. I MCDAREA']"" Q
. I $$UP^XLFSTR($P(^SC(MCDAREA,0),U))'["LAB" Q
. S MCDAREA=$P(^SC(MCDAREA,0),U)
. S MCDIR=$P(^DIC(4,DUZ(2),2,MSCI,0),U),MCDPHONE=$P(^DIC(4,DUZ(2),2,MSCI,0),U,3)
Q
CHK ; check if any results entered for micro
S MSCEXIT=0
I $G(LRSS)="MI" D Q
. I $G(LRDFN)']""!($G(LRIDT)']"") S MSCEXIT=1 Q
. S MSCEXIT=1
. N I F I=1,5,8,11,14,16,31 I $D(^LR(LRDFN,"MI",LRIDT,I)) D ;found data
. . I $L($P(^LR(LRDFN,"MI",LRIDT,I),U,2)) S MSCEXIT=0
. . I $P(^LR(LRDFN,"MI",LRIDT,I),U,2)="P",'MSCAFMP S MSCEXIT=1
Q
EXIT ; kill variables
;D ^%ZISC
K MRN,MSCDOC,MSCDOCNM,MSCEXIT,MSCFAXNU,MSCFXI,MSCFXURG,MSCLRAA,MSCPROC,MSCRAID,MSCX,MSCNOFAX
K MCDIR,MCDAREA,MCDPHONE,MSCTVN,MSCAFMP
D HOME^%ZIS
Q
|