| 1 | SCDXPRN2 ;ALB/JRP - HISTORY FILE REPORTS;21-JUL-1997
|
|---|
| 2 | ;;5.3;Scheduling;**128,135,405**;AUG 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | FULLHIST ;Print full transmission history report
|
|---|
| 5 | ; - Report based within the ACRP Transmission History file (#409.77)
|
|---|
| 6 | ; - User prompted for selection criteria
|
|---|
| 7 | ; Division (one/many/all) Clinic (o/m/a) Patient (o/m/a)
|
|---|
| 8 | ; - User prompted for transmission date range
|
|---|
| 9 | ; - Report formatted for 80 columns (allows output to screen)
|
|---|
| 10 | ;
|
|---|
| 11 | ;Declare variables
|
|---|
| 12 | N VAUTSTR,VAUTNI,VAUTVB,VAUTNALL,VAUTD,VAUTC,VAUTN
|
|---|
| 13 | N SCDXBEG,SCDXEND,SCDXGLO,X,Y,SCDXH,SCDXLOCK
|
|---|
| 14 | ;SD*5.3*405 lock user from running multiple times in same session
|
|---|
| 15 | I $D(^TMP("RPT-LOCK",$J,DUZ)) W !!,"Sorry, you either have this report already running or queued to run.",!,"Please try again later.",!! Q
|
|---|
| 16 | ;Initialize selection global
|
|---|
| 17 | S SCDXGLO=$NA(^TMP("SCDXPRN2",$J,"SELECT"))
|
|---|
| 18 | K @SCDXGLO
|
|---|
| 19 | ;Get division(s) - default to 'ALL' if single division
|
|---|
| 20 | S VAUTD=1 I ($P($G(^DG(43,1,"GL")),"^",2)) D DIVISION^VAUTOMA Q:(Y<0)
|
|---|
| 21 | ;Copy into global location [for tasking]
|
|---|
| 22 | ; Local array not deleted - it's required input for clinic selection
|
|---|
| 23 | M @SCDXGLO@("VAUTD")=VAUTD
|
|---|
| 24 | ;Get clinic(s)
|
|---|
| 25 | S VAUTNI=2 D CLINIC^VAUTOMA Q:(Y<0)
|
|---|
| 26 | ;Copy into global location [for tasking] and delete local array
|
|---|
| 27 | M @SCDXGLO@("VAUTC")=VAUTC
|
|---|
| 28 | K VAUTC
|
|---|
| 29 | ;Delete local array of selected divisions
|
|---|
| 30 | K VAUTD
|
|---|
| 31 | ;Get patient(s)
|
|---|
| 32 | S VAUTNI=2 D PATIENT^VAUTOMA Q:(Y<0)
|
|---|
| 33 | ;Copy into global location [for tasking] and delete array
|
|---|
| 34 | M @SCDXGLO@("VAUTN")=VAUTN
|
|---|
| 35 | K VAUTN
|
|---|
| 36 | ;Set allowable date range
|
|---|
| 37 | S SCDXBEG=2961001
|
|---|
| 38 | S SCDXEND=$$DT^XLFDT()
|
|---|
| 39 | ;Begin date help text
|
|---|
| 40 | S SCDXH("B",1)="Enter transmission date to begin search from"
|
|---|
| 41 | S SCDXH("B",2)=" "
|
|---|
| 42 | S SCDXH("B",3)=$$FMTE^XLFDT(SCDXBEG)_" is the earliest date allowed"
|
|---|
| 43 | S SCDXH("B",4)=$$FMTE^XLFDT(SCDXEND)_" will be the latest date allowed"
|
|---|
| 44 | S SCDXH("B",5)=" "
|
|---|
| 45 | S SCDXH("B",6)="Note: Encounter date does not always match date of"
|
|---|
| 46 | S SCDXH("B")=" transmission to the National Patient Care Database"
|
|---|
| 47 | ; End date help text
|
|---|
| 48 | S SCDXH("E",1)="Enter transmission date to end search at"
|
|---|
| 49 | S SCDXH("E",2)=" "
|
|---|
| 50 | S SCDXH("E",3)=$$FMTE^XLFDT(SCDXEND)_" is the latest date allowed"
|
|---|
| 51 | S SCDXH("E",4)=$$FMTE^XLFDT(SCDXBEG)_" was the earliest date allowed"
|
|---|
| 52 | S SCDXH("E",5)=" "
|
|---|
| 53 | S SCDXH("E",6)="Note: Encounter date does not always match date of"
|
|---|
| 54 | S SCDXH("E")=" transmission to the National Patient Care Database"
|
|---|
| 55 | S X=$$GETDTRNG^SCDXUTL1(SCDXBEG,SCDXEND,$NA(SCDXH("B")),$NA(SCDXH("E")))
|
|---|
| 56 | Q:(X<0)
|
|---|
| 57 | K SCDXH
|
|---|
| 58 | S SCDXBEG=+$P(X,"^",1)
|
|---|
| 59 | S SCDXEND=+$P(X,"^",2)
|
|---|
| 60 | S SCDXLOCK=$J_U_DUZ ;SD*5.3*405 lock variable for when report is queued
|
|---|
| 61 | S ^TMP("RPT-LOCK",$J,DUZ)="" ;SD*5.3*405 set lock for current user
|
|---|
| 62 | ;Queue/run
|
|---|
| 63 | W !!
|
|---|
| 64 | S ZTDESC="ACRP TRANSMISSION HISTORY REPORT"
|
|---|
| 65 | S ZTSAVE("SCDXBEG")=""
|
|---|
| 66 | S ZTSAVE("SCDXEND")=""
|
|---|
| 67 | S ZTSAVE("SCDXGLO")=""
|
|---|
| 68 | S ZTSAVE("SCDXLOCK")="" ;SD*5.3*405
|
|---|
| 69 | S ZTSAVE($$OREF^DILF(SCDXGLO))=""
|
|---|
| 70 | S IOP="Q"
|
|---|
| 71 | D EN^XUTMDEVQ("PRINT^SCDXPRN2",ZTDESC,.ZTSAVE)
|
|---|
| 72 | ;Done - reset IO variables (safety measure) and quit
|
|---|
| 73 | I POP K ^TMP("RPT-LOCK",$J,DUZ)
|
|---|
| 74 | I $D(X) I X="^" K ^TMP("RPT-LOCK",$J,DUZ)
|
|---|
| 75 | D HOME^%ZIS
|
|---|
| 76 | Q
|
|---|
| 77 | ;
|
|---|
| 78 | PRINT ;Print report
|
|---|
| 79 | ;Input : SCDXBEG - Begin date (FileMan)
|
|---|
| 80 | ; - Refers to date/time of transmission (not encounter)
|
|---|
| 81 | ; SCDXEND - End date (FileMan)
|
|---|
| 82 | ; - Refers to date/time of transmission (not encounter)
|
|---|
| 83 | ; SCDXGLO - Global containing selection criteria
|
|---|
| 84 | ; SCDXLOCK- Equals user's DUZ and locks the same user from
|
|---|
| 85 | ; queueing the report more than once at the same time
|
|---|
| 86 | ; This was output of calls to VAUTOMA for division,
|
|---|
| 87 | ; clinic, and patient (full global reference)
|
|---|
| 88 | ; Divisions selected Clinics selected Patients selected
|
|---|
| 89 | ; SCDXGLO("VAUTD") SCDXGLO("VAUTC") SCDXGLO("VAUTN")
|
|---|
| 90 | ; SCDXGLO("VAUTD",x) SCDXGLO("VAUTC",x) SCDXGLO("VAUTN",x)
|
|---|
| 91 | ;Output : None
|
|---|
| 92 | ;Notes : All input is REQUIRED - report will not be generated if
|
|---|
| 93 | ; any of the variables are not defined
|
|---|
| 94 | ; : All input (including global location) will be deleted on exit
|
|---|
| 95 | ; : User will be prompted for device except on queued entry
|
|---|
| 96 | ;
|
|---|
| 97 | ;Declare variables
|
|---|
| 98 | N DIC,L,BY,FR,TO,DHD,FLDS,DISPAR,DIOBEG,DIOEND,IOP,SCDXSLVE,DOLJ
|
|---|
| 99 | ;Define sort criteria
|
|---|
| 100 | S DIC="^SD(409.77,"
|
|---|
| 101 | S L=0
|
|---|
| 102 | ;Define sort array
|
|---|
| 103 | S BY(0)="^TMP(""SCDXPRN2"",$J,""SORT"","
|
|---|
| 104 | S L(0)=6
|
|---|
| 105 | ;Make FileMan think sort already done (set fake value into array)
|
|---|
| 106 | S ^TMP("SCDXPRN2",$J,"SORT",1,2,3,4,5,6)=""
|
|---|
| 107 | ;Define sort routine
|
|---|
| 108 | S DIOBEG="D SORT^SCDXPRN2"
|
|---|
| 109 | ;Define post-report action
|
|---|
| 110 | S DIOEND="K ^TMP(""SCDXPRN2"",$J,""SORT"")"
|
|---|
| 111 | ;Form feed for each clinic
|
|---|
| 112 | S DISPAR(0,2)="#^;"
|
|---|
| 113 | ;Define print fields
|
|---|
| 114 | S FLDS="[SCDX XMIT HIST FULL PRINT]"
|
|---|
| 115 | ;Define header & footer
|
|---|
| 116 | S DHD="[SCDX XMIT HIST FULL HEADER]-[SCDX XMIT HIST FULL FOOTER]"
|
|---|
| 117 | ;Use current device
|
|---|
| 118 | S IOP=IO
|
|---|
| 119 | ;Remember IO("S")
|
|---|
| 120 | S SCDXSLVE=+$G(IO("S"))
|
|---|
| 121 | ;Print report
|
|---|
| 122 | D EN1^DIP
|
|---|
| 123 | ;Reset IO("S")
|
|---|
| 124 | S:(SCDXSLVE) IO("S")=SCDXSLVE
|
|---|
| 125 | ;Delete input array & variables
|
|---|
| 126 | K @SCDXGLO
|
|---|
| 127 | K SCDXBEG,SCDXEND,SCDXGLO
|
|---|
| 128 | ;If queued, purge task
|
|---|
| 129 | S:($D(ZTQUEUED)) ZTREQ="@"
|
|---|
| 130 | ;SD*5.3*405 remove lock for current user
|
|---|
| 131 | K ^TMP("RPT-LOCK",$P(SCDXLOCK,U,1),$P(SCDXLOCK,U,2))
|
|---|
| 132 | Q
|
|---|
| 133 | ;
|
|---|
| 134 | SORT ;Sort routine
|
|---|
| 135 | ;Input : See TASK entry point
|
|---|
| 136 | ;Output : Global containing sorted entries for printing
|
|---|
| 137 | ; ^TMP("SCDXPRN2",$J,"SORT",Div,Clin,Pat,EncDate,VID,DA)
|
|---|
| 138 | ; Div = Division name Clin = Clinic name
|
|---|
| 139 | ; Pat = Patient name EncDate = Encounter date [no time]
|
|---|
| 140 | ; VID = Visit ID DA = Pointer to entry in 409.77
|
|---|
| 141 | ;Notes : ^TMP("SCDXPRN2",$J,"SORT") will be initialized upon entry
|
|---|
| 142 | ; : Existance & validity of input is assumed
|
|---|
| 143 | ;
|
|---|
| 144 | ;Declare variables
|
|---|
| 145 | N HISTPTR,NODE,DATE,NAME,CLINIC,DIVISION,VID
|
|---|
| 146 | N BEGDATE,ENDDATE,TMP,VAUTD,VAUTC,VAUTN
|
|---|
| 147 | ;Make begin and end dates opposing midnights
|
|---|
| 148 | S BEGDATE=$$FMADD^XLFDT($P(SCDXBEG,".",1),-1,23,59,59)
|
|---|
| 149 | S ENDDATE=$$FMADD^XLFDT($P(SCDXEND,".",1),0,23,59,59)
|
|---|
| 150 | ;All divisions selected ?
|
|---|
| 151 | S VAUTD=+$G(@SCDXGLO@("VAUTD"))
|
|---|
| 152 | ;All clinics selected ?
|
|---|
| 153 | S VAUTC=+$G(@SCDXGLO@("VAUTC"))
|
|---|
| 154 | ;All patients selected ?
|
|---|
| 155 | S VAUTN=+$G(@SCDXGLO@("VAUTN"))
|
|---|
| 156 | ;Initialize sort array
|
|---|
| 157 | K ^TMP("SCDXPRN2",$J,"SORT")
|
|---|
| 158 | ;Sort/screen
|
|---|
| 159 | F S BEGDATE=+$O(^SD(409.77,"AXMIT",BEGDATE)) Q:(('BEGDATE)!(BEGDATE>ENDDATE)) D Q:($$S^%ZTLOAD())
|
|---|
| 160 | .S HISTPTR=0
|
|---|
| 161 | .F S HISTPTR=+$O(^SD(409.77,"AXMIT",BEGDATE,HISTPTR)) Q:('HISTPTR) D Q:($$S^%ZTLOAD())
|
|---|
| 162 | ..;Grab zero node of entry
|
|---|
| 163 | ..S NODE=$G(^SD(409.77,HISTPTR,0))
|
|---|
| 164 | ..;Get encounter date (strip time)
|
|---|
| 165 | ..S TMP=+$P(NODE,"^",2)
|
|---|
| 166 | ..S DATE=$P(TMP,".",1)
|
|---|
| 167 | ..;Get patient
|
|---|
| 168 | ..S TMP=+$P(NODE,"^",3)
|
|---|
| 169 | ..S NAME=$P($G(^DPT(TMP,0),"UNKNOWN"),"^",1)
|
|---|
| 170 | ..;Patient selection screen
|
|---|
| 171 | ..I ('VAUTN) Q:('$D(@SCDXGLO@("VAUTN",TMP)))
|
|---|
| 172 | ..;Get clinic
|
|---|
| 173 | ..S TMP=+$P(NODE,"^",4)
|
|---|
| 174 | ..S CLINIC=$P($G(^SC(TMP,0),"UNKNOWN"),"^",1)
|
|---|
| 175 | ..;Clinic selection screen
|
|---|
| 176 | ..I ('VAUTC) Q:('$D(@SCDXGLO@("VAUTC",TMP)))
|
|---|
| 177 | ..;Get division
|
|---|
| 178 | ..S TMP=+$P(NODE,"^",5)
|
|---|
| 179 | ..S DIVISION=$P($G(^DG(40.8,TMP,0),"UNKNOWN"),"^",1)
|
|---|
| 180 | ..;Division selection screen
|
|---|
| 181 | ..I ('VAUTD) Q:('$D(@SCDXGLO@("VAUTD",TMP)))
|
|---|
| 182 | ..;Get visit ID
|
|---|
| 183 | ..S VID=+$P(NODE,"^",6)
|
|---|
| 184 | ..;Store in pre-sort array
|
|---|
| 185 | ..S ^TMP("SCDXPRN2",$J,"SORT",DIVISION,CLINIC,NAME,DATE,VID,HISTPTR)=""
|
|---|
| 186 | ;Done
|
|---|
| 187 | Q
|
|---|
