source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCDXSUP.m@ 1504

Last change on this file since 1504 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 5.9 KB
Line 
1SCDXSUP ;RENO/KEITH ALB/SCK - Consistency checker for Ambulatory Care Reporting Project (ACRP); 02/26/97
2 ;;5.3;Scheduling;**99**;Aug 13, 1993
3 ;
4CQ ;Queue re-calculation of OUTPATIENT ENCOUNTER checkout status
5 ;
6 ; Variable List
7 ; SCBDT - Beginning date for search in Outpatient Encounter file
8 ; SCDT - Outpatient Encounter date
9 ; SCE0 - Zero node of the outpatient encounter
10 ; OEIN - IEN of the outpatient encounter
11 ; SCLINE - Dashed line for report
12 ; SCPNOW - External date
13 ; SCEDT - Ending date for search in Outpatient Encounter file
14 ; PAGE - Number of pages
15 ; SCCT - Count of entries processed
16 ;
17 W !!,"This option will check outpatient encouters with a status of 'CHECKED OUT'"
18 W !,"for a entry in the TRANSMITTED OUTPATIENT ENCOUNTER file."
19 W !,"If no entry exists, and the encounter is for a COUNT Clinic, then "
20 W !,"a transmission entry will be added."
21 W !!,"This may take a while, please queue to a printer!",!
22 ;
23 N SCBDT,SCEDT,SCPFLG
24 S SCBDT=$$ASKDT("Beginning")
25 Q:SCBDT<0
26CQ1 S SCEDT=$$ASKDT("Ending")
27 Q:SCEDT<0
28 I SCEDT<SCBDT D G CQ1
29 . W !!,"Ending date cannot be earlier than the Beginning date!",!
30 ;
31 S SCPFLG=1
32 N ZTSAVE,%ZIS
33 S %ZIS=0,ZTSAVE("SCBDT")="",ZTSAVE("SCEDT")="",ZTSAVE("SCPFLG")=""
34 D EN^XUTMDEVQ("CALC^SCDXSUP","Update Checkout Status",.ZTSAVE,.%ZIS)
35 Q
36 ;
37CQAPI(SCBG,SCED,SCPFLG) ; API entry point for re-calculation of OUTPATIENT ENCOUNTER checkout status
38 ; INPUT:
39 ; SCBG - Beginning date, if passed in, use it
40 ; SCED - Ending date, if passed in, use it
41 ; SCPFLG - Print Report flag
42 ; 1 - Print report
43 ; 0 - Do not print report
44 ;
45 S SCBDT=$G(SCBG)
46 S SCEDT=$G(SCED)
47 ;
48CALC ;Update Checkout Status
49 ;
50 N SCDT,OEIN,SCPNOW,SCLINE,SCE0,SCCT,SCABRT
51 ;
52 K ^TMP("SCMSC",$J)
53 ;
54 ; ** Order through the Outpatatient Encounter file, if the encounter is the parent, evaluate it.
55 S SCDT=SCBDT-.1
56 F S SCDT=$O(^SCE("B",SCDT)) Q:'SCDT!(SCDT>(SCEDT+.99999)) D
57 . S OEIN=0 F S OEIN=$O(^SCE("B",SCDT,OEIN)) Q:'OEIN D
58 .. S SCE0=$G(^SCE(OEIN,0))
59 .. ; ** The following code removes any extraneous 'B' xrefs found that do not
60 .. ; point to a valid entry
61 .. I SCE0']"" D Q
62 ... K ^SCE("B",SCDT,OEIN)
63 .. I '$P(SCE0,U,6) D EVAL(SCE0,OEIN,SCDT)
64 ;
65 G:'$G(SCPFLG) EXIT
66 ;
67 ; ** Prepare report output
68 S SCLINE="",$P(SCLINE,"-",(IOM+1))=""
69 S SCPNOW=$P($$FMTE^XLFDT($$NOW^XLFDT()),":",1,2)
70 S SCBDT=$$FMTE^XLFDT(SCBDT)
71 S SCEDT=$$FMTE^XLFDT(SCEDT)
72 S PAGE=1,SCCT=0
73 ;
74CRTX ;
75 S SCHD="MISSING TRANSMISSION RECORDS CREATED"
76 D HDR
77 I '$D(^TMP("SCMSC",$J,2)) D G NEXT1
78 . W !!,"No encounters with missing transmission records found."
79 ;
80 S (SCDT,SCCT)=0
81 F S SCDT=$O(^TMP("SCMSC",$J,2,SCDT)) Q:'SCDT D Q:$G(SCABRT)
82 . S OEIN=0 F S OEIN=$O(^TMP("SCMSC",$J,2,SCDT,OEIN)) Q:'OEIN D Q:$G(SCABRT)
83 .. S SCE0=^TMP("SCMSC",$J,2,SCDT,OEIN) D PRT(SCE0)
84 ;
85 I $Y>(IOSL-5) D:$$NEWPAGE HDR
86 W !!,SCCT," transmission record",$S(SCCT=1:"",1:"s")," created."
87 ;
88NEXT1 ;
89 S SCHD="COUNT CLINIC ENCOUNTERS SET FOR RETRANSMIT"
90 S X=$$NEWPAGE Q:$G(SCABRT)
91 S PAGE=1
92 W:'(IOST?1"C-".E) @IOF
93 D HDR
94 I '$D(^TMP("SCMSC",$J,3)) D G EXIT
95 . W !!,"No Count Clinic encounters found needing retransmission."
96 ;
97 S (SCDT,SCCT)=0
98 F S SCDT=$O(^TMP("SCMSC",$J,3,SCDT)) Q:'SCDT D Q:$G(SCABRT)
99 . S OEIN=0 F S OEIN=$O(^TMP("SCMSC",$J,3,SCDT,OEIN)) Q:'OEIN D Q:$G(SCABRT)
100 .. S SCE0=^TMP("SCMSC",$J,3,SCDT,OEIN) D PRT(SCE0)
101 ;
102 D:$Y>(IOSL-5) HDR W !!,SCCT," Count clinic encounters marked for retransmission."
103 ;
104EXIT ;
105 K %ZIS,SCHD,PAGE,SCEDT,SCBDT,SCPT0
106 K ^TMP("SCMSC",$J)
107 Q
108 ;
109EVAL(SC0,OEIN,SDT) ;Evaluate checkout status
110 ; ** If the encounter appt. status is CHECKED OUT, and the check out process is
111 ; completed, but there is no entry for the encounter in the Transmitted
112 ; Outpatient Encounter file, then process the encounter into the Transmitted
113 ; Outpatient Encounter File, #409.73
114 ;
115 ; If clinic is NON-COUNT and Checked out, then change STATUS field, #.12, from
116 ; CHECKED OUT to NON-COUNT and exit.
117 ;
118 ; Input:
119 ; SC0 - 0 node of the Outpatient encounter
120 ; OEIN - IEN of the Outpatient encounter
121 ; SDT - Date of the Outpatient encounter
122 ;
123 ; Output
124 ; ^TMP("SCMSC",$J,n,SDT,OEIN)=SC0
125 ;
126 ; Variables
127 ; SCTOE - IEN of entry created in the Transmitted Outpatient Encounter file
128 ; -1 if unable to create entry
129 ;
130 N SCTOE
131 I $P(SC0,U,12)=2,$P(SC0,U,7),'$D(^SD(409.73,"AENC",OEIN)) D Q
132 . I $P($G(^SC(+$P(SC0,U,4),0)),U,17)="Y" D Q
133 .. S DA=OEIN,DR=".12////12",DIE="^SCE("
134 .. D ^DIE K DIE,DR
135 . S SCTOE=$$CRTXMIT^SCDXFU01(OEIN)
136 . I SCTOE>0 D STREEVNT^SCDXFU01(SCTOE,1),XMITFLAG^SCDXFU01(SCTOE,0) S ^TMP("SCMSC",$J,2,SDT,OEIN)=SC0
137 ;
138 I $P(SC0,U,12)=12,$P(SC0,U,7) D
139 . I $P($G(^SC(+$P(SC0,U,4),0)),U,17)="Y" Q
140 . S DA=OEIN,DR=".12////2",DIE="^SCE("
141 . D ^DIE K DIE,DR
142 . S SCTOE=+$O(^SD(409.73,"AENC",OEIN,0))
143 . I 'SCTOE D
144 .. S SCTOE=$$CRTXMIT^SCDXFU01(OEIN)
145 . I SCTOE>0 D STREEVNT^SCDXFU01(SCTOE,1),XMITFLAG^SCDXFU01(SCTOE,0) S ^TMP("SCMSC",$J,3,SDT,OEIN)=SC0
146 ;
147 Q
148 ;
149HDR ; Header
150 W:PAGE>1 @IOF
151 W !,SCLINE,!,?(IOM-($L(SCHD)+10)\2),"<*> ",SCHD," <*>",!,SCLINE
152 W !,"For date range ",SCBDT," to ",SCEDT
153 W !,"Date printed: ",SCPNOW,?(IOM-7-$L(PAGE)),"Page: ",PAGE,!
154 ;
155 W !,"Patient",?21,"SSN",?33,"Appointment",?56,"Clinic",!,SCLINE
156 S PAGE=PAGE+1
157 ;
158 Q
159 ;
160PRT(SC0) ;Print appointment
161 ;
162 I $Y>(IOSL-5) D:$$NEWPAGE HDR Q:$G(SCABRT)
163 S SCCT=SCCT+1,SCPT0=^DPT($P(SC0,U,2),0)
164 W !,$E($P(SCPT0,U),1,18),?21,$P(SCPT0,U,9)
165 W ?33,$P($$FMTE^XLFDT($P(SC0,U)),":",1,2)
166 W ?56,$E($P($G(^SC(+$P(SC0,U,4),0)),U),1,(IOM-56))
167 Q
168 ;
169ASKDT(TXT) ; Enter beginning date for searching outpatient encounter file
170 S DIR(0)="DA^::EXP",DIR("A")="Enter "_TXT_" date for search: "
171 S DIR("?")="^D HELP^%DTC"
172 S DIR("B")=$$FMTE^XLFDT($$DT^XLFDT())
173 D ^DIR K DIR
174 S:$D(DIRUT) Y=-1
175 K DIRUT
176 Q Y
177 ;
178NEWPAGE() ; Check device and display prompt for terminals
179 N DIR,SCOK
180 I IOST?1"C-".E D
181 . W !
182 . S DIR(0)="E" D ^DIR S SCABRT='$G(Y)
183 . I 'SCABRT S SCOK=1 W @IOF
184 Q +$G(SCOK)
Note: See TracBrowser for help on using the repository browser.