1 | GMTSPL ; SLC/JER,KER - Print/Queue HS for Patient Lists ; 02/27/2002 [1/27/05 8:27am]
|
---|
2 | ;;2.7;Health Summary;**7,27,28,30,47,49,70**;Oct 20, 1995;Build 5
|
---|
3 | ;
|
---|
4 | ; External References
|
---|
5 | ; DBIA 10090 ^DIC(4
|
---|
6 | ; DBIA 10039 ^DIC(42
|
---|
7 | ; DBIA 10035 ^DPT(
|
---|
8 | ; DBIA 10035 ^DPT("CN"
|
---|
9 | ; DBIA 10040 ^SC(
|
---|
10 | ; DBIA 16 ^SRF(
|
---|
11 | ; DBIA 641 ^SRF("AOR"
|
---|
12 | ; DBIA 185 ^SRS("B"
|
---|
13 | ; DBIA 10091 ^XMB(1
|
---|
14 | ; DBIA 10000 C^%DTC
|
---|
15 | ; DBIA 10000 NOW^%DTC
|
---|
16 | ; DBIA 10026 ^DIR
|
---|
17 | ; DBIA 183 DFN^PSOSD1
|
---|
18 | ; DBIA 10104 $$UP^XLFSTR
|
---|
19 | ; DBIA 2056 $$GET1^DIQ (file #44)
|
---|
20 | ;
|
---|
21 | MAIN ; Print/Queue for Patient Lists
|
---|
22 | ;
|
---|
23 | ; Call with:
|
---|
24 | ;
|
---|
25 | ; GMTSTYP = Pointer to file 142
|
---|
26 | ; GMTSSC = Pointer to file 44^Hosp Loc Name^
|
---|
27 | ; Hosp Loc Type^Begin Visit/Surg Date^
|
---|
28 | ; Opt end Visit/Surgery Date
|
---|
29 | ; GMTSSC() = GMTSSC - Array of multiple locations
|
---|
30 | ; [GMPSAP] = Optional flag set to 1 if OP Rx
|
---|
31 | ; Action Profile is to print
|
---|
32 | ;
|
---|
33 | N MULTLOC,GMTSEXIT S GMTSEXIT=0
|
---|
34 | I $D(GMTSSC("ALL")) D Q
|
---|
35 | . N IEN,BEG,END,COR,PRM,RAN,PAT
|
---|
36 | . S PRM=$G(GMTSSC),BEG=$P(PRM,"^",4),END=$P(PRM,"^",5)
|
---|
37 | . S RAN=BEG S:$L(END)&($L(RAN)) RAN=RAN_"^"_END S:$L(END)&('$L(RAN)) RAN=END
|
---|
38 | . S IEN=0 F S IEN=$O(^SC(IEN)) Q:+IEN=0 D Q:$G(GMTSEXIT)["^^"
|
---|
39 | . . N GMTSSC,NAM S NAM=$$GET1^DIQ(44,(+IEN_","),.01) Q:'$L(NAM)
|
---|
40 | . . S COR=$$GET1^DIQ(44,(+IEN_","),2,"I") Q:COR="" Q:"WCOR"'[COR
|
---|
41 | . . S GMTSSC=IEN_"^"_NAM_"^"_COR
|
---|
42 | . . S:"COR"[COR&($L($G(RAN))) GMTSSC=GMTSSC_"^"_RAN
|
---|
43 | . . S PAT=$$PAT(GMTSSC) Q:+PAT=0
|
---|
44 | . . D CTRL
|
---|
45 | I +$O(GMTSSC(0))'>0 D CTRL
|
---|
46 | I +$O(GMTSSC(0)) D
|
---|
47 | . S MULTLOC=0 F S MULTLOC=$O(GMTSSC(MULTLOC)) Q:+MULTLOC'>0!$D(DIROUT) D
|
---|
48 | . . S GMTSSC=GMTSSC(+MULTLOC) D CTRL
|
---|
49 | Q
|
---|
50 | CTRL ; Controls Branching
|
---|
51 | N DFN,GMTDFN,GMLTYPE,GMTSLTR,GMPNM,PSOPAR,PSONOPG,PSOINST,PSTYPE K ^TMP("GMTSPL",$J) U IO
|
---|
52 | N GMTSBYE S GMTSBYE=0
|
---|
53 | S GMLTYPE=$P(GMTSSC,U,3) S:GMLTYPE="C" GMTSBYE=$$CLINIC(GMTSSC) D:GMLTYPE="W" WARD(GMTSSC) D:GMLTYPE="OR" OR(GMTSSC)
|
---|
54 | I GMTSBYE Q
|
---|
55 | I $L($P(GMTSSC,U,2)),($E(IOST,1)'="C") S GMTSLTR=$E($P(GMTSSC,U,2),1,10) D ^GMTSLTR
|
---|
56 | I $O(^TMP("GMTSPL",$J,0))="",$D(GMTSSC("ALL")) W !,"ALL" Q
|
---|
57 | I $O(^TMP("GMTSPL",$J,0))="" D NOPAT($P(GMTSSC,U,2)) Q
|
---|
58 | S GMPNM="" F S GMPNM=$O(^TMP("GMTSPL",$J,GMPNM)) Q:(GMPNM="")!($D(DIROUT)) D
|
---|
59 | . S GMTDFN=0 F S GMTDFN=$O(^TMP("GMTSPL",$J,GMPNM,GMTDFN)) Q:(GMTDFN'>0)!($D(DIROUT)) D
|
---|
60 | . . N GMDUOUT
|
---|
61 | . . S DFN=GMTDFN D DRIVER Q:$D(DIROUT)!+$G(GMDUOUT)
|
---|
62 | . . I +$G(GMPSAP) D
|
---|
63 | . . . S (PSTYPE,PSONOPG)=1
|
---|
64 | . . . S $P(PSOPAR,U)=$S($P($G(^GMT(142.99,1,0)),U,5)="Y":1,1:0)
|
---|
65 | . . . S PSOINST=$S(+$G(PSOINST):PSOINST,1:+$P($G(^DIC(4,+$P($G(^XMB(1,1,"XUS")),U,17),99)),U))
|
---|
66 | . . . D DFN^PSOSD1,PAGE
|
---|
67 | K ^TMP("GMTSPL",$J)
|
---|
68 | Q
|
---|
69 | PAGE ; Pause at BOP for interactive users
|
---|
70 | N DIR,X,Y
|
---|
71 | Q:$E(IOST)'="C"!(IOT="HFS")!((IOSL>998)&($G(GMPAT(+$O(GMPAT(""),-1)))'=$G(DFN)))
|
---|
72 | I IOSL>($Y+5) F W ! Q:IOSL<($Y+6)!($Y'<22)
|
---|
73 | S DIR(0)="FO^1:1",DIR("A")="Press RETURN to continue or '^' to exit"
|
---|
74 | S DIR("?")="Enter '^' to quit present report or '^^' to quit to menu"
|
---|
75 | D ^DIR S:X["^^" DIROUT=1
|
---|
76 | Q
|
---|
77 | NOPAT(LOC) ; Handles unpopulated Hospital location
|
---|
78 | N %,%H,%I,%T,%Y,GMTS,GMTSDTM,GMTSTN,GMTSHDR,GMTSPG,GMTSTITL,GMTSDTM,GMTSLFG,X,Y
|
---|
79 | D NOW^%DTC S X=% D REGDTM4^GMTSU S GMTSDTM=X,GMTSTN=$P($G(^GMT(142,+($G(GMTSTYP)),0)),"^",1)
|
---|
80 | S DIC=142,DIC(0)="NXF",X=GMTSTN S Y=$$TYPE^GMTSULT K DIC
|
---|
81 | S GMTSTITL=$S($D(^GMT(142,+Y,"T")):^("T"),1:$P(Y,U,2)),GMTSLFG=1
|
---|
82 | W @IOF D HEADER^GMTSUP W !!,"No Patients found at ",LOC," location.",!
|
---|
83 | Q
|
---|
84 | CLINIC(LOC) ; Gets list of next-day appointments for clinic
|
---|
85 | N %,%H,%I,%T,%Y,GMI,X,X1,X2,VDT,Y,GMPNM,GMDT,GMBDT,GMEDT,GMTSRES,GMTSCDT,GMDFN,GMNAME,GMDATE,GMTSLAST
|
---|
86 | S GMTSCDT=$P(LOC,U,4),GMI=0
|
---|
87 | I 'GMTSCDT D NOW^%DTC S GMTSCDT=X
|
---|
88 | S X=+GMTSCDT D REGDT4^GMTSU S GMBDT=X
|
---|
89 | S X=+$P(LOC,U,5) D REGDT4^GMTSU S GMEDT=X
|
---|
90 | S:+$P(LOC,U,5) X1=$P(LOC,U,5),X2=1
|
---|
91 | S:+$P(LOC,U,5)'>0 X1=GMTSCDT,X2=1 D C^%DTC
|
---|
92 | S GMTSLAST=X
|
---|
93 | D GETPLIST^SDAMA202(+LOC,"1;4",,GMTSCDT,GMTSLAST,.GMTSRES)
|
---|
94 | I GMTSRES<0 D Q "-1"
|
---|
95 | . N GMTSERR
|
---|
96 | . S GMTSERR=$O(^TMP($J,"SDAMA202","GETPLIST","ERROR",0))
|
---|
97 | . I 'GMTSERR Q
|
---|
98 | . D MAIL^GMTSMAIL($G(^TMP($J,"SDAMA202","GETPLIST","ERROR",GMTSERR)),"Print/Queue HS for Patient Lists")
|
---|
99 | . K ^TMP($J,"SDAMA202","GETPLIST")
|
---|
100 | F S GMI=$O(^TMP($J,"SDAMA202","GETPLIST",GMI)) Q:GMI="" D
|
---|
101 | . N X
|
---|
102 | . S X=$G(^TMP($J,"SDAMA202","GETPLIST",GMI,1))
|
---|
103 | . Q:X>GMTSLAST
|
---|
104 | . D REGDT4^GMTSU S GMDATE=X
|
---|
105 | . S GMDFN=+$G(^TMP($J,"SDAMA202","GETPLIST",GMI,4))
|
---|
106 | . S GMNAME=$P($G(^TMP($J,"SDAMA202","GETPLIST",GMI,4)),U,2)
|
---|
107 | . S ^TMP("GMTSPL",$J,GMNAME,+GMDFN)=$S($D(^TMP("GMTSPL",$J,GMNAME,+GMDFN)):GMBDT_" TO "_GMEDT,1:GMDATE)
|
---|
108 | K ^TMP($J,"SDAMA202","GETPLIST")
|
---|
109 | Q 0
|
---|
110 | WARD(LOC) ; Gets list of patients for a ward
|
---|
111 | N DFN,GMLOC,X,Y,GMDT
|
---|
112 | S GMLOC=$P($G(^DIC(42,+$G(^SC(+LOC,42)),0)),U)
|
---|
113 | I $S('$L(GMLOC):1,'$O(^DPT("CN",GMLOC,0)):1,1:0) Q
|
---|
114 | S DFN=0 F S DFN=$O(^DPT("CN",GMLOC,DFN)) Q:+DFN'>0 D
|
---|
115 | . N X
|
---|
116 | . S X=+$G(DT) D REGDT4^GMTSU S GMDT=X
|
---|
117 | . S ^TMP("GMTSPL",$J,$P($G(^DPT(+DFN,0)),U),+DFN)=GMDT
|
---|
118 | Q
|
---|
119 | OR(LOC) ; Gets list of patients scheduled for surgery
|
---|
120 | N GMBEG,GMEND,DFN,GMI,GMJ,GMPNM,GMDT,%,%H,%I,%T,%Y,X,X1,X2,Y
|
---|
121 | S GMI=+$O(^SRS("B",+LOC,0)) I +GMI'>0 G ORX
|
---|
122 | S GMBEG=$P(LOC,U,4)-.0001,GMEND=$S(+$P(LOC,U,5)>0:$P(LOC,U,5),1:$P(LOC,U,4))
|
---|
123 | F S GMBEG=$O(^SRF("AOR",+GMI,+GMBEG)) Q:+GMBEG'>0!(+GMBEG>+GMEND) D
|
---|
124 | . S GMJ=0 F S GMJ=$O(^SRF("AOR",+GMI,+GMBEG,GMJ)) Q:+GMJ'>0 D
|
---|
125 | . . S DFN=+$G(^SRF(+GMJ,0)) Q:DFN'>0
|
---|
126 | . . S GMPNM=$P($G(^DPT(+DFN,0)),U)
|
---|
127 | . . N X
|
---|
128 | . . S X=+GMBEG D REGDT4^GMTSU S GMDT=X
|
---|
129 | . . S ^TMP("GMTSPL",$J,GMPNM,+DFN)=$S($D(^TMP("GMTSPL",$J,GMPNM,+DFN)):^(+DFN)_", "_GMDT,1:GMDT)
|
---|
130 | ORX ; Exit Surgery
|
---|
131 | Q
|
---|
132 | PAT(LOC) ; Checks for patients at selected location
|
---|
133 | N %,%H,%T,LTYPE,X1,X2,X,Y,GMY,GMBEG,GMTSDATE,GMTSCDT,GMTSRES S LTYPE=$P(LOC,U,3),GMY=0
|
---|
134 | I LTYPE="W" D
|
---|
135 | . S LOC=$P($G(^DIC(42,+$G(^SC(+LOC,42)),0)),U),GMY=$S($G(LOC)']"":0,$O(^DPT("CN",LOC,0)):1,1:0)
|
---|
136 | I $L(LOC,U)=4!($L(LOC,U)=5) D
|
---|
137 | . S GMY=0 S:+$P(LOC,U,5) X1=$P(LOC,U,5),X2=1 S:+$P(LOC,U,5)'>0 X1=$P(LOC,U,4),X2=1 D C^%DTC
|
---|
138 | . S GMTSCDT=$P(LOC,U,4)
|
---|
139 | . D GETPLIST^SDAMA202(+LOC,"1",,GMTSCDT,X,.GMTSRES) Q:GMTSRES=0
|
---|
140 | . I GMTSRES<0 D Q
|
---|
141 | . . N GMTSERR
|
---|
142 | . . S GMTSERR=$O(^TMP($J,"SDAMA202","GETPLIST","ERROR",0))
|
---|
143 | . . I 'GMTSERR Q
|
---|
144 | . . D MAIL^GMTSMAIL($G(^TMP($J,"SDAMA202","GETPLIST","ERROR",GMTSERR)),"Print/Queue HS for Patient Lists")
|
---|
145 | . . K ^TMP($J,"SDAMA202","GETPLIST")
|
---|
146 | . N GMTSI S GMTSI=0,GMTSDATE=0
|
---|
147 | . F S GMTSI=$O(^TMP($J,"SDAMA202","GETPLIST",GMTSI)) Q:'GMTSI D
|
---|
148 | . . I $G(^TMP($J,"SDAMA202","GETPLIST",GMTSI,1))<X S GMTSDATE=$G(^TMP($J,"SDAMA202","GETPLIST",GMTSI,1))
|
---|
149 | . K ^TMP($J,"SDAMA202","GETPLIST")
|
---|
150 | . I LTYPE="C",(+GMTSDATE),(+GMTSDATE'>X) S GMY=1
|
---|
151 | . I LTYPE="OR" D
|
---|
152 | . . N OLOC S GMY=0,OLOC=+$O(^SRS("B",+LOC,0))
|
---|
153 | . . I +OLOC,+$P(LOC,U,5)'>0,$O(^SRF("AOR",+OLOC,+$P(LOC,U,4),0)) S GMY=1
|
---|
154 | . . I +OLOC,+$P(LOC,U,5) S GMBEG=$P(LOC,U,4) F D Q:GMBEG>$P(LOC,U,5)!(GMY>0)
|
---|
155 | . . . S:$O(^SRF("AOR",+OLOC,+GMBEG,0)) GMY=1 Q:+GMY>0 S X1=GMBEG,X2=1 D C^%DTC S GMBEG=X
|
---|
156 | Q $G(GMY)
|
---|
157 | DRIVER ; Sets variables for GMTS1 and calls ^%ZTLOAD
|
---|
158 | N %T,C,D0,GMTS,GMTS0,GMTS1,GMTS2,GMTSDOB,GMTSDTM,GMTSLO,GMTSLOCK
|
---|
159 | N GMTSLPG,GMTSEG,GMTSEGC,GMTSTN,GMTSEGI,GMTSPNM,GMTSRB
|
---|
160 | N GMTSSN,GMTSTITL,GMTSWARD,GMTSX,GMTSPHDR,GMTSAGE,GMTSTOF,GMTSCDT
|
---|
161 | N GMW,I,SEX,VA,VADM,VAIN,VAINDT,VAROOT,X,Y
|
---|
162 | S GMTSCDT(0)=^TMP("GMTSPL",$J,GMPNM,+DFN),GMTSTN=$P($G(^GMT(142,+($G(GMTSTYP)),0)),"^",1)
|
---|
163 | S DIC=142,DIC(0)="NXF",X=GMTSTN S Y=$$TYPE^GMTSULT K DIC
|
---|
164 | S GMTSTITL=$$UP^XLFSTR($S($G(^GMT(142,+Y,"T"))]"":^("T"),1:$P(Y,U,2)))
|
---|
165 | D:$D(GMTSEG)'>9 SELTYP1^GMTS D EN^GMTS1
|
---|
166 | Q
|
---|