SDPPRT ;ALB/CAW - Patient Profile - Print ;10/15/93
;;5.3;Scheduling;**6,19,41,140,132,1015**;AUG 13, 1993;Build 21
;
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
SDPPRT ;ALB/CAW - Patient Profile - Print ;10/15/93
+1 ;;5.3;Scheduling;**6,19,41,140,132,1015**;AUG 13, 1993;Build 21
+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
