SCDXPRN2 ;ALB/JRP - HISTORY FILE REPORTS;21-JUL-1997
;;5.3;Scheduling;**128,135,405,1015**;AUG 13, 1993;Build 21
;
FULLHIST ;Print full transmission history report
; - Report based within the ACRP Transmission History file (#409.77)
; - User prompted for selection criteria
; Division (one/many/all) Clinic (o/m/a) Patient (o/m/a)
; - User prompted for transmission date range
; - Report formatted for 80 columns (allows output to screen)
;
;Declare variables
N VAUTSTR,VAUTNI,VAUTVB,VAUTNALL,VAUTD,VAUTC,VAUTN
N SCDXBEG,SCDXEND,SCDXGLO,X,Y,SCDXH,SCDXLOCK
;SD*5.3*405 lock user from running multiple times in same session
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
;Initialize selection global
S SCDXGLO=$NA(^TMP("SCDXPRN2",$J,"SELECT"))
K @SCDXGLO
;Get division(s) - default to 'ALL' if single division
S VAUTD=1 I ($P($G(^DG(43,1,"GL")),"^",2)) D DIVISION^VAUTOMA Q:(Y<0)
;Copy into global location [for tasking]
; Local array not deleted - it's required input for clinic selection
M @SCDXGLO@("VAUTD")=VAUTD
;Get clinic(s)
S VAUTNI=2 D CLINIC^VAUTOMA Q:(Y<0)
;Copy into global location [for tasking] and delete local array
M @SCDXGLO@("VAUTC")=VAUTC
K VAUTC
;Delete local array of selected divisions
K VAUTD
;Get patient(s)
S VAUTNI=2 D PATIENT^VAUTOMA Q:(Y<0)
;Copy into global location [for tasking] and delete array
M @SCDXGLO@("VAUTN")=VAUTN
K VAUTN
;Set allowable date range
S SCDXBEG=2961001
S SCDXEND=$$DT^XLFDT()
;Begin date help text
S SCDXH("B",1)="Enter transmission date to begin search from"
S SCDXH("B",2)=" "
S SCDXH("B",3)=$$FMTE^XLFDT(SCDXBEG)_" is the earliest date allowed"
S SCDXH("B",4)=$$FMTE^XLFDT(SCDXEND)_" will be the latest date allowed"
S SCDXH("B",5)=" "
S SCDXH("B",6)="Note: Encounter date does not always match date of"
S SCDXH("B")=" transmission to the National Patient Care Database"
; End date help text
S SCDXH("E",1)="Enter transmission date to end search at"
S SCDXH("E",2)=" "
S SCDXH("E",3)=$$FMTE^XLFDT(SCDXEND)_" is the latest date allowed"
S SCDXH("E",4)=$$FMTE^XLFDT(SCDXBEG)_" was the earliest date allowed"
S SCDXH("E",5)=" "
S SCDXH("E",6)="Note: Encounter date does not always match date of"
S SCDXH("E")=" transmission to the National Patient Care Database"
S X=$$GETDTRNG^SCDXUTL1(SCDXBEG,SCDXEND,$NA(SCDXH("B")),$NA(SCDXH("E")))
Q:(X<0)
K SCDXH
S SCDXBEG=+$P(X,"^",1)
S SCDXEND=+$P(X,"^",2)
S SCDXLOCK=$J_U_DUZ ;SD*5.3*405 lock variable for when report is queued
S ^TMP("RPT-LOCK",$J,DUZ)="" ;SD*5.3*405 set lock for current user
;Queue/run
W !!
S ZTDESC="ACRP TRANSMISSION HISTORY REPORT"
S ZTSAVE("SCDXBEG")=""
S ZTSAVE("SCDXEND")=""
S ZTSAVE("SCDXGLO")=""
S ZTSAVE("SCDXLOCK")="" ;SD*5.3*405
S ZTSAVE($$OREF^DILF(SCDXGLO))=""
S IOP="Q"
D EN^XUTMDEVQ("PRINT^SCDXPRN2",ZTDESC,.ZTSAVE)
;Done - reset IO variables (safety measure) and quit
I POP K ^TMP("RPT-LOCK",$J,DUZ)
I $D(X) I X="^" K ^TMP("RPT-LOCK",$J,DUZ)
D HOME^%ZIS
Q
;
PRINT ;Print report
;Input : SCDXBEG - Begin date (FileMan)
; - Refers to date/time of transmission (not encounter)
; SCDXEND - End date (FileMan)
; - Refers to date/time of transmission (not encounter)
; SCDXGLO - Global containing selection criteria
; SCDXLOCK- Equals user's DUZ and locks the same user from
; queueing the report more than once at the same time
; This was output of calls to VAUTOMA for division,
; clinic, and patient (full global reference)
; Divisions selected Clinics selected Patients selected
; SCDXGLO("VAUTD") SCDXGLO("VAUTC") SCDXGLO("VAUTN")
; SCDXGLO("VAUTD",x) SCDXGLO("VAUTC",x) SCDXGLO("VAUTN",x)
;Output : None
;Notes : All input is REQUIRED - report will not be generated if
; any of the variables are not defined
; : All input (including global location) will be deleted on exit
; : User will be prompted for device except on queued entry
;
;Declare variables
N DIC,L,BY,FR,TO,DHD,FLDS,DISPAR,DIOBEG,DIOEND,IOP,SCDXSLVE,DOLJ
;Define sort criteria
S DIC="^SD(409.77,"
S L=0
;Define sort array
S BY(0)="^TMP(""SCDXPRN2"",$J,""SORT"","
S L(0)=6
;Make FileMan think sort already done (set fake value into array)
S ^TMP("SCDXPRN2",$J,"SORT",1,2,3,4,5,6)=""
;Define sort routine
S DIOBEG="D SORT^SCDXPRN2"
;Define post-report action
S DIOEND="K ^TMP(""SCDXPRN2"",$J,""SORT"")"
;Form feed for each clinic
S DISPAR(0,2)="#^;"
;Define print fields
S FLDS="[SCDX XMIT HIST FULL PRINT]"
;Define header & footer
S DHD="[SCDX XMIT HIST FULL HEADER]-[SCDX XMIT HIST FULL FOOTER]"
;Use current device
S IOP=IO
;Remember IO("S")
S SCDXSLVE=+$G(IO("S"))
;Print report
D EN1^DIP
;Reset IO("S")
S:(SCDXSLVE) IO("S")=SCDXSLVE
;Delete input array & variables
K @SCDXGLO
K SCDXBEG,SCDXEND,SCDXGLO
;If queued, purge task
S:($D(ZTQUEUED)) ZTREQ="@"
;SD*5.3*405 remove lock for current user
K ^TMP("RPT-LOCK",$P(SCDXLOCK,U,1),$P(SCDXLOCK,U,2))
Q
;
SORT ;Sort routine
;Input : See TASK entry point
;Output : Global containing sorted entries for printing
; ^TMP("SCDXPRN2",$J,"SORT",Div,Clin,Pat,EncDate,VID,DA)
; Div = Division name Clin = Clinic name
; Pat = Patient name EncDate = Encounter date [no time]
; VID = Visit ID DA = Pointer to entry in 409.77
;Notes : ^TMP("SCDXPRN2",$J,"SORT") will be initialized upon entry
; : Existance & validity of input is assumed
;
;Declare variables
N HISTPTR,NODE,DATE,NAME,CLINIC,DIVISION,VID
N BEGDATE,ENDDATE,TMP,VAUTD,VAUTC,VAUTN
;Make begin and end dates opposing midnights
S BEGDATE=$$FMADD^XLFDT($P(SCDXBEG,".",1),-1,23,59,59)
S ENDDATE=$$FMADD^XLFDT($P(SCDXEND,".",1),0,23,59,59)
;All divisions selected ?
S VAUTD=+$G(@SCDXGLO@("VAUTD"))
;All clinics selected ?
S VAUTC=+$G(@SCDXGLO@("VAUTC"))
;All patients selected ?
S VAUTN=+$G(@SCDXGLO@("VAUTN"))
;Initialize sort array
K ^TMP("SCDXPRN2",$J,"SORT")
;Sort/screen
F S BEGDATE=+$O(^SD(409.77,"AXMIT",BEGDATE)) Q:(('BEGDATE)!(BEGDATE>ENDDATE)) D Q:($$S^%ZTLOAD())
.S HISTPTR=0
.F S HISTPTR=+$O(^SD(409.77,"AXMIT",BEGDATE,HISTPTR)) Q:('HISTPTR) D Q:($$S^%ZTLOAD())
..;Grab zero node of entry
..S NODE=$G(^SD(409.77,HISTPTR,0))
..;Get encounter date (strip time)
..S TMP=+$P(NODE,"^",2)
..S DATE=$P(TMP,".",1)
..;Get patient
..S TMP=+$P(NODE,"^",3)
..S NAME=$P($G(^DPT(TMP,0),"UNKNOWN"),"^",1)
..;Patient selection screen
..I ('VAUTN) Q:('$D(@SCDXGLO@("VAUTN",TMP)))
..;Get clinic
..S TMP=+$P(NODE,"^",4)
..S CLINIC=$P($G(^SC(TMP,0),"UNKNOWN"),"^",1)
..;Clinic selection screen
..I ('VAUTC) Q:('$D(@SCDXGLO@("VAUTC",TMP)))
..;Get division
..S TMP=+$P(NODE,"^",5)
..S DIVISION=$P($G(^DG(40.8,TMP,0),"UNKNOWN"),"^",1)
..;Division selection screen
..I ('VAUTD) Q:('$D(@SCDXGLO@("VAUTD",TMP)))
..;Get visit ID
..S VID=+$P(NODE,"^",6)
..;Store in pre-sort array
..S ^TMP("SCDXPRN2",$J,"SORT",DIVISION,CLINIC,NAME,DATE,VID,HISTPTR)=""
;Done
Q
SCDXPRN2 ;ALB/JRP - HISTORY FILE REPORTS;21-JUL-1997
+1 ;;5.3;Scheduling;**128,135,405,1015**;AUG 13, 1993;Build 21
+2 ;
FULLHIST ;Print full transmission history report
+1 ; - Report based within the ACRP Transmission History file (#409.77)
+2 ; - User prompted for selection criteria
+3 ; Division (one/many/all) Clinic (o/m/a) Patient (o/m/a)
+4 ; - User prompted for transmission date range
+5 ; - Report formatted for 80 columns (allows output to screen)
+6 ;
+7 ;Declare variables
+8 NEW VAUTSTR,VAUTNI,VAUTVB,VAUTNALL,VAUTD,VAUTC,VAUTN
+9 NEW SCDXBEG,SCDXEND,SCDXGLO,X,Y,SCDXH,SCDXLOCK
+10 ;SD*5.3*405 lock user from running multiple times in same session
+11 IF $DATA(^TMP("RPT-LOCK",$JOB,DUZ))
WRITE !!,"Sorry, you either have this report already running or queued to run.",!,"Please try again later.",!!
QUIT
+12 ;Initialize selection global
+13 SET SCDXGLO=$NAME(^TMP("SCDXPRN2",$JOB,"SELECT"))
+14 KILL @SCDXGLO
+15 ;Get division(s) - default to 'ALL' if single division
+16 SET VAUTD=1
IF ($PIECE($GET(^DG(43,1,"GL")),"^",2))
DO DIVISION^VAUTOMA
IF (Y<0)
QUIT
+17 ;Copy into global location [for tasking]
+18 ; Local array not deleted - it's required input for clinic selection
+19 MERGE @SCDXGLO@("VAUTD")=VAUTD
+20 ;Get clinic(s)
+21 SET VAUTNI=2
DO CLINIC^VAUTOMA
IF (Y<0)
QUIT
+22 ;Copy into global location [for tasking] and delete local array
+23 MERGE @SCDXGLO@("VAUTC")=VAUTC
+24 KILL VAUTC
+25 ;Delete local array of selected divisions
+26 KILL VAUTD
+27 ;Get patient(s)
+28 SET VAUTNI=2
DO PATIENT^VAUTOMA
IF (Y<0)
QUIT
+29 ;Copy into global location [for tasking] and delete array
+30 MERGE @SCDXGLO@("VAUTN")=VAUTN
+31 KILL VAUTN
+32 ;Set allowable date range
+33 SET SCDXBEG=2961001
+34 SET SCDXEND=$$DT^XLFDT()
+35 ;Begin date help text
+36 SET SCDXH("B",1)="Enter transmission date to begin search from"
+37 SET SCDXH("B",2)=" "
+38 SET SCDXH("B",3)=$$FMTE^XLFDT(SCDXBEG)_" is the earliest date allowed"
+39 SET SCDXH("B",4)=$$FMTE^XLFDT(SCDXEND)_" will be the latest date allowed"
+40 SET SCDXH("B",5)=" "
+41 SET SCDXH("B",6)="Note: Encounter date does not always match date of"
+42 SET SCDXH("B")=" transmission to the National Patient Care Database"
+43 ; End date help text
+44 SET SCDXH("E",1)="Enter transmission date to end search at"
+45 SET SCDXH("E",2)=" "
+46 SET SCDXH("E",3)=$$FMTE^XLFDT(SCDXEND)_" is the latest date allowed"
+47 SET SCDXH("E",4)=$$FMTE^XLFDT(SCDXBEG)_" was the earliest date allowed"
+48 SET SCDXH("E",5)=" "
+49 SET SCDXH("E",6)="Note: Encounter date does not always match date of"
+50 SET SCDXH("E")=" transmission to the National Patient Care Database"
+51 SET X=$$GETDTRNG^SCDXUTL1(SCDXBEG,SCDXEND,$NAME(SCDXH("B")),$NAME(SCDXH("E")))
+52 IF (X<0)
QUIT
+53 KILL SCDXH
+54 SET SCDXBEG=+$PIECE(X,"^",1)
+55 SET SCDXEND=+$PIECE(X,"^",2)
+56 ;SD*5.3*405 lock variable for when report is queued
SET SCDXLOCK=$JOB_U_DUZ
+57 ;SD*5.3*405 set lock for current user
SET ^TMP("RPT-LOCK",$JOB,DUZ)=""
+58 ;Queue/run
+59 WRITE !!
+60 SET ZTDESC="ACRP TRANSMISSION HISTORY REPORT"
+61 SET ZTSAVE("SCDXBEG")=""
+62 SET ZTSAVE("SCDXEND")=""
+63 SET ZTSAVE("SCDXGLO")=""
+64 ;SD*5.3*405
SET ZTSAVE("SCDXLOCK")=""
+65 SET ZTSAVE($$OREF^DILF(SCDXGLO))=""
+66 SET IOP="Q"
+67 DO EN^XUTMDEVQ("PRINT^SCDXPRN2",ZTDESC,.ZTSAVE)
+68 ;Done - reset IO variables (safety measure) and quit
+69 IF POP
KILL ^TMP("RPT-LOCK",$JOB,DUZ)
+70 IF $DATA(X)
IF X="^"
KILL ^TMP("RPT-LOCK",$JOB,DUZ)
+71 DO HOME^%ZIS
+72 QUIT
+73 ;
PRINT ;Print report
+1 ;Input : SCDXBEG - Begin date (FileMan)
+2 ; - Refers to date/time of transmission (not encounter)
+3 ; SCDXEND - End date (FileMan)
+4 ; - Refers to date/time of transmission (not encounter)
+5 ; SCDXGLO - Global containing selection criteria
+6 ; SCDXLOCK- Equals user's DUZ and locks the same user from
+7 ; queueing the report more than once at the same time
+8 ; This was output of calls to VAUTOMA for division,
+9 ; clinic, and patient (full global reference)
+10 ; Divisions selected Clinics selected Patients selected
+11 ; SCDXGLO("VAUTD") SCDXGLO("VAUTC") SCDXGLO("VAUTN")
+12 ; SCDXGLO("VAUTD",x) SCDXGLO("VAUTC",x) SCDXGLO("VAUTN",x)
+13 ;Output : None
+14 ;Notes : All input is REQUIRED - report will not be generated if
+15 ; any of the variables are not defined
+16 ; : All input (including global location) will be deleted on exit
+17 ; : User will be prompted for device except on queued entry
+18 ;
+19 ;Declare variables
+20 NEW DIC,L,BY,FR,TO,DHD,FLDS,DISPAR,DIOBEG,DIOEND,IOP,SCDXSLVE,DOLJ
+21 ;Define sort criteria
+22 SET DIC="^SD(409.77,"
+23 SET L=0
+24 ;Define sort array
+25 SET BY(0)="^TMP(""SCDXPRN2"",$J,""SORT"","
+26 SET L(0)=6
+27 ;Make FileMan think sort already done (set fake value into array)
+28 SET ^TMP("SCDXPRN2",$JOB,"SORT",1,2,3,4,5,6)=""
+29 ;Define sort routine
+30 SET DIOBEG="D SORT^SCDXPRN2"
+31 ;Define post-report action
+32 SET DIOEND="K ^TMP(""SCDXPRN2"",$J,""SORT"")"
+33 ;Form feed for each clinic
+34 SET DISPAR(0,2)="#^;"
+35 ;Define print fields
+36 SET FLDS="[SCDX XMIT HIST FULL PRINT]"
+37 ;Define header & footer
+38 SET DHD="[SCDX XMIT HIST FULL HEADER]-[SCDX XMIT HIST FULL FOOTER]"
+39 ;Use current device
+40 SET IOP=IO
+41 ;Remember IO("S")
+42 SET SCDXSLVE=+$GET(IO("S"))
+43 ;Print report
+44 DO EN1^DIP
+45 ;Reset IO("S")
+46 IF (SCDXSLVE)
SET IO("S")=SCDXSLVE
+47 ;Delete input array & variables
+48 KILL @SCDXGLO
+49 KILL SCDXBEG,SCDXEND,SCDXGLO
+50 ;If queued, purge task
+51 IF ($DATA(ZTQUEUED))
SET ZTREQ="@"
+52 ;SD*5.3*405 remove lock for current user
+53 KILL ^TMP("RPT-LOCK",$PIECE(SCDXLOCK,U,1),$PIECE(SCDXLOCK,U,2))
+54 QUIT
+55 ;
SORT ;Sort routine
+1 ;Input : See TASK entry point
+2 ;Output : Global containing sorted entries for printing
+3 ; ^TMP("SCDXPRN2",$J,"SORT",Div,Clin,Pat,EncDate,VID,DA)
+4 ; Div = Division name Clin = Clinic name
+5 ; Pat = Patient name EncDate = Encounter date [no time]
+6 ; VID = Visit ID DA = Pointer to entry in 409.77
+7 ;Notes : ^TMP("SCDXPRN2",$J,"SORT") will be initialized upon entry
+8 ; : Existance & validity of input is assumed
+9 ;
+10 ;Declare variables
+11 NEW HISTPTR,NODE,DATE,NAME,CLINIC,DIVISION,VID
+12 NEW BEGDATE,ENDDATE,TMP,VAUTD,VAUTC,VAUTN
+13 ;Make begin and end dates opposing midnights
+14 SET BEGDATE=$$FMADD^XLFDT($PIECE(SCDXBEG,".",1),-1,23,59,59)
+15 SET ENDDATE=$$FMADD^XLFDT($PIECE(SCDXEND,".",1),0,23,59,59)
+16 ;All divisions selected ?
+17 SET VAUTD=+$GET(@SCDXGLO@("VAUTD"))
+18 ;All clinics selected ?
+19 SET VAUTC=+$GET(@SCDXGLO@("VAUTC"))
+20 ;All patients selected ?
+21 SET VAUTN=+$GET(@SCDXGLO@("VAUTN"))
+22 ;Initialize sort array
+23 KILL ^TMP("SCDXPRN2",$JOB,"SORT")
+24 ;Sort/screen
+25 FOR
SET BEGDATE=+$ORDER(^SD(409.77,"AXMIT",BEGDATE))
IF (('BEGDATE)!(BEGDATE>ENDDATE))
QUIT
Begin DoDot:1
+26 SET HISTPTR=0
+27 FOR
SET HISTPTR=+$ORDER(^SD(409.77,"AXMIT",BEGDATE,HISTPTR))
IF ('HISTPTR)
QUIT
Begin DoDot:2
+28 ;Grab zero node of entry
+29 SET NODE=$GET(^SD(409.77,HISTPTR,0))
+30 ;Get encounter date (strip time)
+31 SET TMP=+$PIECE(NODE,"^",2)
+32 SET DATE=$PIECE(TMP,".",1)
+33 ;Get patient
+34 SET TMP=+$PIECE(NODE,"^",3)
+35 SET NAME=$PIECE($GET(^DPT(TMP,0),"UNKNOWN"),"^",1)
+36 ;Patient selection screen
+37 IF ('VAUTN)
IF ('$DATA(@SCDXGLO@("VAUTN",TMP)))
QUIT
+38 ;Get clinic
+39 SET TMP=+$PIECE(NODE,"^",4)
+40 SET CLINIC=$PIECE($GET(^SC(TMP,0),"UNKNOWN"),"^",1)
+41 ;Clinic selection screen
+42 IF ('VAUTC)
IF ('$DATA(@SCDXGLO@("VAUTC",TMP)))
QUIT
+43 ;Get division
+44 SET TMP=+$PIECE(NODE,"^",5)
+45 SET DIVISION=$PIECE($GET(^DG(40.8,TMP,0),"UNKNOWN"),"^",1)
+46 ;Division selection screen
+47 IF ('VAUTD)
IF ('$DATA(@SCDXGLO@("VAUTD",TMP)))
QUIT
+48 ;Get visit ID
+49 SET VID=+$PIECE(NODE,"^",6)
+50 ;Store in pre-sort array
+51 SET ^TMP("SCDXPRN2",$JOB,"SORT",DIVISION,CLINIC,NAME,DATE,VID,HISTPTR)=""
End DoDot:2
IF ($$S^%ZTLOAD())
QUIT
End DoDot:1
IF ($$S^%ZTLOAD())
QUIT
+52 ;Done
+53 QUIT
