Routine: SCDXPRN2

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

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))

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

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

SCDXPRN2.m