SDPPRT.m

SDPPRT ;ALB/CAW - Patient Profile - Print ;10/15/93

 ;;5.3;Scheduling;**6,19,41,140,132**;AUG 13, 1993

 ;

EN ;Print entire patient profile

 ;

 D ENS^%ZISS

 D DIR G:SDERR ENQ

 W !!,$$LINE("Device Selection")

 S %ZIS="PMQ" D ^%ZIS I POP G ENQ

 I '$D(IO("Q")) D PRINT G ENQ

 S Y=$$QUE

ENQ D:'$D(ZTQUEUED) ^%ZISC

 K SDERR,SDTYP S VALMBCK="R" Q

 ;

QUE() ; -- que job

 ; return: did job que [ 1|yes   0|no ]

 ;

 N X K ZTSK,IO("Q")

 S ZTDESC="Patient Profile",ZTRTN="PRINT^SDPPRT"

 F X="DFN","SDACT","SDBD","SDBEG","SDED","SDEND","SDTYP","SDTYP(","SDPRINT","SDRANGE" S ZTSAVE(X)=""

 D ^%ZTLOAD W:$D(ZTSK) "   (Task: ",ZTSK,")"

 Q $D(ZTSK)

 ;

PRINT ;Print actual patient profile

 U IO N SDWHERE,SDALL,SDGO K ^TMP("SD",$J),^TMP("SDAPT",$J),^TMP("SDENR",$J),^TMP("SDPP",$J),^TMP("SDPPALL",$J)

 S (SDPAGE,SDTYP)=0,SDGO=1 D INIT1^SDPP,INIT^SDPPALL

 S (SDALL,SDWHERE)=0 I '$$HDR G PRINTQ

 F  S SDWHERE=$O(^TMP("SDPP",$J,SDWHERE)) Q:'SDWHERE  S:($Y+6>IOSL) SDGO=$$HDR G:'SDGO PRINTQ W !,^TMP("SDPP",$J,SDWHERE,0)

 F  S SDALL=$O(^TMP("SDPPALL",$J,SDALL)) Q:'SDALL  S:($Y+6>IOSL) SDGO=$$HDR G:'SDGO PRINTQ W !,^TMP("SDPPALL",$J,SDALL,0)

PRINTQ K ^TMP("SDPP",$J),^TMP("SDPPALL",$J) S SDLN=0 D:'$D(ZTQUEUED) INIT1^SDPP

 I SDGO,SDPAGE,$E(IOST,1,2)="C-" D PAUSE^VALM1 Q

 Q

LINE(STR) ; -- print line

 ;  input: STR := text to insert

 ; output: none

 ; return: text to use

 ;

 N X

 S:STR]"" STR=" "_STR_" "

 S $P(X,"_",(IOM/2)-($L(STR)/2))=""

 Q X_STR_X

 ;

DIR ;Ask what they want printed

 N SDYN S SDPRINT=1,SDERR=0

 I $O(^DPT(DFN,"S",SDBD)) D  I SDERR G DIRQ

 .S DIR(0)="Y",DIR("B")="YES",DIR("A")="Do you want to print appointments",DIR("?")="Enter 'NO' if you do not want the appointments, otherwise enter 'YES'."

 .D ^DIR K DIR I $D(DIRUT) S SDERR=1 Q

 .I Y S SDTYP(2)=""

 IF $$EXOE^SDOE(DFN,SDBD,SDED) D  I SDERR G DIRQ

 .S DIR(0)="Y",DIR("B")="YES",DIR("A")="Do you want to print add/edits",DIR("?")="Enter 'NO' if you do not want the add/edits, otherwise enter 'YES'."

 .D ^DIR K DIR I $D(DIRUT) S SDERR=1 Q

 .I Y S SDTYP(1)=""

 I $D(^DPT(DFN,"DE")) D  I SDERR G DIRQ

 .S DIR(0)="Y",DIR("B")="YES",DIR("A")="Do you want to print enrollments",DIR("?")="Enter 'NO' if you do not want the enrollments, otherwise enter 'YES'."

 .D ^DIR K DIR I $D(DIRUT) S SDERR=1 Q

 .I Y S SDTYP(4)="",SDACT=0

 I $D(^DPT(DFN,"DIS")),$S('SDRANGE:1,+$O(^("DIS",9999999-(SDED+.9)))&($O(^(9999999-(SDED+.9)))<(9999999-(SDBD-.1))):1,1:0) D  I SDERR G DIRQ

 .S DIR(0)="Y",DIR("B")="YES",DIR("A")="Do you want to print dispositions",DIR("?")="Enter 'NO' if you do not want the dispositions, otherwise enter 'YES'."

 .D ^DIR K DIR I $D(DIRUT) S SDERR=1 Q

 .I Y S SDTYP(3)=""

 S SDYN=$$LST^DGMTU(DFN) I SDYN D  I SDERR G DIRQ

 .S DIR(0)="Y",DIR("B")="YES",DIR("A")="Do you want to print means test",DIR("?")="Enter 'NO' if you do not want the means test, otherwise enter 'YES'."

 .D ^DIR K DIR I $D(DIRUT) S SDERR=1 Q

 .I Y S SDTYP(5)=""

 ;adding team information - chris mckee 2/6/96

 S DIR(0)="Y",DIR("B")="YES",DIR("A")="Do you want to print team information",DIR("?")="Enter 'NO' if you do not want the team information, otherwise enter 'YES'."

 D ^DIR K DIR I $D(DIRUT) S SDERR=1 Q

 I Y S SDTYP(7)="",GBL="^TMP(""SDPP"","_$J_")"

DIRQ Q

 ;

HDR() ; -- print header

 ;  return: continue processing [ 1|yes   0|no ]

 ;

 N Y

 I SDPAGE,$E(IOST,1,2)="C-" D PAUSE^VALM1 G:'Y HDRQ

 S SDPAGE=SDPAGE+1 D PID^VADPT6

 W @IOF,*13,"PATIENT PROFILE: ",$P(^DPT(DFN,0),U)_" ("_VA("BID")_")",?45,$S($D(^DPT(DFN,.1)):"Ward: "_^(.1),1:"Outpatient"),?70,"Page: ",SDPAGE

 ;

 W !,"Dates: ",$S(SDBD:$TR($$FMTE^XLFDT(SDBD,"5DF")," ","0"),1:"All"),$S(SDED'=9999999:" to "_$TR($$FMTE^XLFDT(SDED,"5DF")," ","0"),1:" Dates")

 W ?45,"Report Date: ",$P($$NOW^VALM1,":",1,2)

 W !,SDASH S Y=1

HDRQ Q Y

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SDPPRT   3812     printed  Feb 19, 2025@00:26:20                                                                                                                                                                                                      Page 2

SDPPRT    ;ALB/CAW - Patient Profile - Print ;10/15/93

 +1       ;;5.3;Scheduling;**6,19,41,140,132**;AUG 13, 1993

 +2       ;

EN        ;Print entire patient profile

 +1       ;

 +2        DO ENS^%ZISS

 +3        DO DIR

           if SDERR

               GOTO ENQ

 +4        WRITE !!,$$LINE("Device Selection")

 +5        SET %ZIS="PMQ"

           DO ^%ZIS

           IF POP

               GOTO ENQ

 +6        IF '$DATA(IO("Q"))

               DO PRINT

               GOTO ENQ

 +7        SET Y=$$QUE

ENQ        if '$DATA(ZTQUEUED)

               DO ^%ZISC

 +1        KILL SDERR,SDTYP

           SET VALMBCK="R"

           QUIT 

 +2       ;

QUE()     ; -- que job

 +1       ; return: did job que [ 1|yes   0|no ]

 +2       ;

 +3        NEW X

           KILL ZTSK,IO("Q")

 +4        SET ZTDESC="Patient Profile"

           SET ZTRTN="PRINT^SDPPRT"

 +5        FOR X="DFN","SDACT","SDBD","SDBEG","SDED","SDEND","SDTYP","SDTYP(","SDPRINT","SDRANGE"

               SET ZTSAVE(X)=""

 +6        DO ^%ZTLOAD

           if $DATA(ZTSK)

               WRITE "   (Task: ",ZTSK,")"

 +7        QUIT $DATA(ZTSK)

 +8       ;

PRINT     ;Print actual patient profile

 +1        USE IO

           NEW SDWHERE,SDALL,SDGO

           KILL ^TMP("SD",$JOB),^TMP("SDAPT",$JOB),^TMP("SDENR",$JOB),^TMP("SDPP",$JOB),^TMP("SDPPALL",$JOB)

 +2        SET (SDPAGE,SDTYP)=0

           SET SDGO=1

           DO INIT1^SDPP

           DO INIT^SDPPALL

 +3        SET (SDALL,SDWHERE)=0

           IF '$$HDR

               GOTO PRINTQ

 +4        FOR 

               SET SDWHERE=$ORDER(^TMP("SDPP",$JOB,SDWHERE))

               if 'SDWHERE

                   QUIT 

               if ($Y+6>IOSL)

                   SET SDGO=$$HDR

               if 'SDGO

                   GOTO PRINTQ

               WRITE !,^TMP("SDPP",$JOB,SDWHERE,0)

 +5        FOR 

               SET SDALL=$ORDER(^TMP("SDPPALL",$JOB,SDALL))

               if 'SDALL

                   QUIT 

               if ($Y+6>IOSL)

                   SET SDGO=$$HDR

               if 'SDGO

                   GOTO PRINTQ

               WRITE !,^TMP("SDPPALL",$JOB,SDALL,0)

PRINTQ     KILL ^TMP("SDPP",$JOB),^TMP("SDPPALL",$JOB)

           SET SDLN=0

           if '$DATA(ZTQUEUED)

               DO INIT1^SDPP

 +1        IF SDGO

               IF SDPAGE

                   IF $EXTRACT(IOST,1,2)="C-"

                       DO PAUSE^VALM1

                       QUIT 

 +2        QUIT 

LINE(STR) ; -- print line

 +1       ;  input: STR := text to insert

 +2       ; output: none

 +3       ; return: text to use

 +4       ;

 +5        NEW X

 +6        if STR]""

               SET STR=" "_STR_" "

 +7        SET $PIECE(X,"_",(IOM/2)-($LENGTH(STR)/2))=""

 +8        QUIT X_STR_X

 +9       ;

DIR       ;Ask what they want printed

 +1        NEW SDYN

           SET SDPRINT=1

           SET SDERR=0

 +2        IF $ORDER(^DPT(DFN,"S",SDBD))

               Begin DoDot:1

 +3                SET DIR(0)="Y"

                   SET DIR("B")="YES"

                   SET DIR("A")="Do you want to print appointments"

                   SET DIR("?")="Enter 'NO' if you do not want the appointments, otherwise enter 'YES'."

 +4                DO ^DIR

                   KILL DIR

                   IF $DATA(DIRUT)

                       SET SDERR=1

                       QUIT 

 +5                IF Y

                       SET SDTYP(2)=""

               End DoDot:1

               IF SDERR

                   GOTO DIRQ

 +6        IF $$EXOE^SDOE(DFN,SDBD,SDED)

               Begin DoDot:1

 +7                SET DIR(0)="Y"

                   SET DIR("B")="YES"

                   SET DIR("A")="Do you want to print add/edits"

                   SET DIR("?")="Enter 'NO' if you do not want the add/edits, otherwise enter 'YES'."

 +8                DO ^DIR

                   KILL DIR

                   IF $DATA(DIRUT)

                       SET SDERR=1

                       QUIT 

 +9                IF Y

                       SET SDTYP(1)=""

               End DoDot:1

               IF SDERR

                   GOTO DIRQ

 +10       IF $DATA(^DPT(DFN,"DE"))

               Begin DoDot:1

 +11               SET DIR(0)="Y"

                   SET DIR("B")="YES"

                   SET DIR("A")="Do you want to print enrollments"

                   SET DIR("?")="Enter 'NO' if you do not want the enrollments, otherwise enter 'YES'."

 +12               DO ^DIR

                   KILL DIR

                   IF $DATA(DIRUT)

                       SET SDERR=1

                       QUIT 

 +13               IF Y

                       SET SDTYP(4)=""

                       SET SDACT=0

               End DoDot:1

               IF SDERR

                   GOTO DIRQ

 +14       IF $DATA(^DPT(DFN,"DIS"))

               IF $SELECT('SDRANGE:1,+$ORDER(^("DIS",9999999-(SDED+.9)))&($ORDER(^(9999999-(SDED+.9)))<(9999999-(SDBD-.1))):1,1:0)

                   Begin DoDot:1

 +15                   SET DIR(0)="Y"

                       SET DIR("B")="YES"

                       SET DIR("A")="Do you want to print dispositions"

                       SET DIR("?")="Enter 'NO' if you do not want the dispositions, otherwise enter 'YES'."

 +16                   DO ^DIR

                       KILL DIR

                       IF $DATA(DIRUT)

                           SET SDERR=1

                           QUIT 

 +17                   IF Y

                           SET SDTYP(3)=""

                   End DoDot:1

                   IF SDERR

                       GOTO DIRQ

 +18       SET SDYN=$$LST^DGMTU(DFN)

           IF SDYN

               Begin DoDot:1

 +19               SET DIR(0)="Y"

                   SET DIR("B")="YES"

                   SET DIR("A")="Do you want to print means test"

                   SET DIR("?")="Enter 'NO' if you do not want the means test, otherwise enter 'YES'."

 +20               DO ^DIR

                   KILL DIR

                   IF $DATA(DIRUT)

                       SET SDERR=1

                       QUIT 

 +21               IF Y

                       SET SDTYP(5)=""

               End DoDot:1

               IF SDERR

                   GOTO DIRQ

 +22      ;adding team information - chris mckee 2/6/96

 +23       SET DIR(0)="Y"

           SET DIR("B")="YES"

           SET DIR("A")="Do you want to print team information"

           SET DIR("?")="Enter 'NO' if you do not want the team information, otherwise enter 'YES'."

 +24       DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)

               SET SDERR=1

               QUIT 

 +25       IF Y

               SET SDTYP(7)=""

               SET GBL="^TMP(""SDPP"","_$JOB_")"

DIRQ       QUIT 

 +1       ;

HDR()     ; -- print header

 +1       ;  return: continue processing [ 1|yes   0|no ]

 +2       ;

 +3        NEW Y

 +4        IF SDPAGE

               IF $EXTRACT(IOST,1,2)="C-"

                   DO PAUSE^VALM1

                   if 'Y

                       GOTO HDRQ

 +5        SET SDPAGE=SDPAGE+1

           DO PID^VADPT6

 +6        WRITE @IOF,*13,"PATIENT PROFILE: ",$PIECE(^DPT(DFN,0),U)_" ("_VA("BID")_")",?45,$SELECT($DATA(^DPT(DFN,.1)):"Ward: "_^(.1),1:"Outpatient"),?70,"Page: ",SDPAGE

 +7       ;

 +8        WRITE !,"Dates: ",$SELECT(SDBD:$TRANSLATE($$FMTE^XLFDT(SDBD,"5DF")," ","0"),1:"All"),$SELECT(SDED'=9999999:" to "_$TRANSLATE($$FMTE^XLFDT(SDED,"5DF")," ","0"),1:" Dates")

 +9        WRITE ?45,"Report Date: ",$PIECE($$NOW^VALM1,":",1,2)

 +10       WRITE !,SDASH

           SET Y=1

HDRQ       QUIT Y