GMTSDVR ; SLC/JER,KER - Health Summary Driver ; 04/30/2002
;;2.7;Health Summary;**6,16,27,28,30,31,35,49,55**;Oct 20, 1995
;
; External References
; DBIA 10090 ^DIC(4
; DBIA 510 ^DISV(
; DBIA 10035 ^DPT(
; DBIA 10091 ^XMB(1
; DBIA 10076 ^XUSEC("GMTS VIEW ONLY"
; DBIA 2160 ^XUTL("OR"
; DBIA 10086 ^%ZIS
; DBIA 10089 ^%ZISC
; DBIA 10063 ^%ZTLOAD
; DBIA 148 PATIENT^ORU1
; DBIA 183 DFN^PSOSD1
; DBIA 10141 $$VERSION^XPDUTL
;
MAIN ; Control branching
N C,I,GMTYP,VADM,VAROOT,ZTRTN,GMPSAP
K DIROUT,DUOUT
F D Q:$D(DUOUT)!$D(DIROUT)!($D(GMTYP)'>9)
. D SELTYP Q:$D(DUOUT)!$D(DIROUT)!($D(GMTYP)'>9)
. N GMPAT,GMP
. F Q:$D(DIROUT) D Q:$D(DUOUT)!$D(DIROUT)!(+$D(GMPAT)'>0)!(+($G(ORVP))>0)
. . K GMP,GMPAT
. . I +($G(ORVP)) S GMPAT(1)=+($G(ORVP))
. . E F Q:$D(DIROUT) K ^XUTL("OR",$J,"ORU"),^("ORV"),^("ORW"),^("ORLP"),GMP D PTPC Q:$S($D(DUOUT):1,$D(DIROUT):1,'+$G(GMP):1,1:0) D
. . . W !!,"Another patient(s) can be selected."
. . Q:$D(DUOUT)!$D(DIROUT)!(+$D(GMPAT)'>0)
. . N GMTSPX1,GMTSPX2
. . I +$G(GMRANGE)>0 D GETRANGE^GMTSU(.GMTSPX2,.GMTSPX1) Q:$G(GMTSPX1)=""!($G(GMTSPX2)="")
. . Q:$D(DUOUT)!$D(DIROUT)
. . D RESUB(.GMPAT)
. . S GMPSAP=$$RXAP^GMTSPD2 Q:$D(DIROUT)!$D(DUOUT)!$D(DTOUT)
. . S ZTRTN="PQ^GMTSDVR"
. . D HSOUT
K ^XUTL("OR",$J,"ORU"),^("ORV"),^("ORW"),^("ORLP")
Q
PTPC ; Combined Patient/Patient Copy
N GMTSPRO,GMTSVER S GMTSVER=+($$VERSION^XPDUTL("OR")),GMTSPRO=+($$PROK^GMTSU("ORU1",11))
D:GMTSVER>2.9&(GMTSPRO) PATIENT^ORU1(.GMP,,"I $P($G(^(""OOS"")),""^"")")
D:GMTSVER'>2.9!('GMTSPRO) PATIENT^ORU1(.GMP) D PATCOPY^GMTSDVR(.GMP,.GMPAT)
Q
PATCOPY(GMP,GMPAT) ; Copies patients from GMP to GMPAT array
N IFN,GMDFN
S IFN=0
; GMPAT(NAME,GMDFN) - alphabetic order by patient
F S IFN=$O(GMP(IFN)) Q:IFN'>0 D
. S GMDFN=+$G(GMP(IFN))
. ; Get name from ^DPT to prevent duplicates
. S GMPAT($P($G(^DPT(GMDFN,0)),U),+GMDFN)=+GMDFN
Q
RESUB(GMP) ; Resubscript GMP Array
; Subscripts in GMP array are converted to numeric
N NAME,GMDFN,CNT
S CNT=0,NAME=""
F S NAME=$O(GMP(NAME)) Q:NAME']"" D
. S GMDFN=0
. F S GMDFN=$O(GMP(NAME,GMDFN)) Q:GMDFN'>0 D
. . S CNT=CNT+1
. . S GMP(CNT)=GMP(NAME,GMDFN)
. . K GMP(NAME,GMDFN)
Q
;
ENXQ ; External call for tasked HS print
;
; Input: GMTSTYP=Record # of HS type in file 142
; DFN=Record # of patient in file 2
; GMTSPX1=Optional internal FM ending date
; GMTSPX2=Optional internal FM beginning date
;
; NOTE: Optional date range variables are both
; required if a date range is desired.
;
; To call from TaskMan:
; S ZTRTN="ENXQ^GMTSDVR"
; S ZTSAVE("GMTSTYP")=""
; S ZTSAVE("DFN")=""
; D ^%ZTLOAD
D ENX(DFN,GMTSTYP,$G(GMTSPX2),$G(GMTSPX1))
Q
;
ENX(DFN,GMTSTYP,GMTSPX2,GMTSPX1) ; External call to print a Health Summary
;
; Input: GMTSTYP=Record # of HS type in file 142
; DFN=Record # of patient in file 2
; GMTSPX1=Optional internal FM ending date
; GMTSPX2=Optional internal FM beginning date
;
; NOTE: Optional date range variables are both
; required if a date range is desired.
;
N DI,DX,DY,GMQUIT,GMTYP,GMPAT,VADM,VAIN,VAROOT
F Q:($D(^GMT(142,+GMTSTYP,1))>9)&$D(^DPT(DFN))!+$G(GMQUIT) D
. I $D(^GMT(142,+GMTSTYP,1))'>9 D
. . I $D(ZTQUEUED) S GMQUIT=1 Q
. . W !?3,"Invalid HEALTH SUMMARY TYPE." D SELTYP S GMTSTYP=+$G(GMTYP(1))
. I '$D(^DPT(DFN)) D
. . I $D(ZTQUEUED) S GMQUIT=1 Q
. . W !?3,"Invalid PATIENT ID." D PATIENT^ORU1(.GMPAT) S DFN=+$G(GMPAT(1))
Q:+$G(GMQUIT)
S:$D(GMTYP)'>9 GMTYP(0)=1,GMTYP(1)=+$G(GMTSTYP)_U_$P($G(^GMT(142,+GMTSTYP,0)),U)
S:$D(GMPAT)'>9 GMPAT=1,GMPAT(0)=1,GMPAT(1)=DFN_U_$P($G(^DPT(DFN,0)),U)
D PQ
Q
SELTYP ; Select Health Summary Type(s)
N DIC,X,Y
S DIC=142,DIC("A")="Select Health Summary Type: ",DIC(0)="AEMQZ"
S DIC("S")="I $P(^(0),U)'=""GMTS HS ADHOC OPTION"""
I $D(GMTYP)<10 S DIC("B")=$S($D(^DISV(DUZ,"^GMT(142,"))=10:$G(^DISV(DUZ,"^GMT(142,",$O(^("^GMT(142,",0)))),1:$P($G(^GMT(142,+$G(^DISV(DUZ,"^GMT(142,")),0)),U))
K GMTYP S Y=$$TYPE^GMTSULT Q:+Y'>0
I $S($D(^GMT(142,+Y,1,0))=0:1,$O(^(0))'>0:1,1:0) W !,"The Summary Type "_$P(Y,U,2)_" includes no components...Please choose another",! Q
S GMTYP(0)=1,GMTYP(1)=Y_U_$P(Y,U,2)_U_$P(Y,U,2)_U_$P(Y,U,2)
Q
PQ ; Queued subroutine for HS by patient
N DFN,GMTI,GMTS,GMTS1,GMTS2,GMTSAGE,GMTSDOB,GMTSDTM,GMTSLO,GMTSLPG,GMTSPNM
N GMTSRB,GMTSSN,GMTSTOF,GMTSTYP,GMTSTITL,GMTSWARD,GMTJ,I,IX0,J,M4,P17,SEX
N GMTSPHDR,TRFAC,VAERR,VAIN
S GMTI=0 F S GMTI=$O(GMTYP(GMTI)) Q:GMTI'>0!$D(DIROUT) D
. N GMTSEG,GMTSEGC,GMTSEGI
. S GMTSTYP=+$G(GMTYP(GMTI)),GMTSTITL=$G(^GMT(142,+GMTSTYP,"T"))
. S:'$L(GMTSTITL) GMTSTITL=$P(GMTYP(GMTI),U,2)
. D LOADSEG
. S GMTJ=0 F S GMTJ=$O(GMPAT(GMTJ)) Q:GMTJ'>0!$D(DIROUT) D
. . S DFN=+$G(GMPAT(GMTJ))
. . N GMDUOUT
. . D EN^GMTS1
. . Q:$D(DIROUT)!+$G(GMDUOUT)
. . D ACTPROF^GMTSDVR(DFN)
Q
LOADSEG ; Load Enabled Components into GMTSEG Array
N GMTI,GMTJ,GMX
S (GMTI,GMTJ)=0 F S GMTJ=$O(^GMT(142,GMTSTYP,1,GMTJ)) Q:GMTJ'>0 S GMX=^(GMTJ,0) D
.S GMTI=GMTI+1,GMTSEG(GMTI)=GMX,GMTSEGI($P(GMX,U,2))=GMTI D SELFILE
S GMTSEGC=GMTI
Q
SELFILE ; Get Selection item information for GMTSEG(
N GMTK S GMTK=0 F S GMTK=$O(^GMT(142,GMTSTYP,1,GMTJ,1,GMTK)) Q:GMTK'>0 D
. N GMTSE,GMTSR,GMTSF S GMTSE=^(GMTK,0),GMTSR=U_$P(GMTSE,";",2) Q:GMTSR="^"
. S GMTSF=+$P(@(GMTSR_"0)"),U,2) Q:+GMTSF=0
. S GMTSEG(GMTI,GMTSF,GMTK)=$P(GMTSE,";"),GMTSEG(GMTI,GMTSF,0)=GMTSR
Q
HSOUT ; Output summary, with device control
; Call with: ZTRTN
I $D(^XUSEC("GMTS VIEW ONLY",DUZ)) D @ZTRTN Q
N %ZIS,IOP
S %ZIS="PQ" D ^%ZIS Q:POP
G:$D(IO("Q")) QUE
NOQUE ; Do Not Queue Output
D @ZTRTN D ^%ZISC
Q
QUE ; Queue output
N %,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTSK
Q:'$D(ZTRTN) K IO("Q"),ZTSAVE F %="DFN","GM*","ENTRY","O*" S ZTSAVE(%)=""
S ZTDESC="HEALTH SUMMARY",ZTIO=ION
D ^%ZTLOAD W !,$S($D(ZTSK):"Request Queued!",1:"Request Cancelled!")
K ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE D ^%ZISC
S IOP="HOME" D ^%ZIS
Q
ACTPROF(GMDFN) ; Print Action Profile for Patient
N DFN,PSTYPE,PSONOPG,PSOPAR,PSOINST
I +$G(GMPSAP) D
. S (PSTYPE,PSONOPG)=1,DFN=GMDFN
. S $P(PSOPAR,U)=$S($P($G(^GMT(142.99,1,0)),U,5)="Y":1,1:0)
. S PSOINST=$S(+$G(PSOINST):PSOINST,1:+$P($G(^DIC(4,+$P($G(^XMB(1,1,"XUS")),U,17),99)),U))
. D DFN^PSOSD1
. S DFN=GMDFN
. ; Reset DFN because ^PSOSD1 call kills it
. D PAGE^GMTSPL
GMTSDVR ; SLC/JER,KER - Health Summary Driver ; 04/30/2002
+1 ;;2.7;Health Summary;**6,16,27,28,30,31,35,49,55**;Oct 20, 1995
+2 ;
+3 ; External References
+4 ; DBIA 10090 ^DIC(4
+5 ; DBIA 510 ^DISV(
+6 ; DBIA 10035 ^DPT(
+7 ; DBIA 10091 ^XMB(1
+8 ; DBIA 10076 ^XUSEC("GMTS VIEW ONLY"
+9 ; DBIA 2160 ^XUTL("OR"
+10 ; DBIA 10086 ^%ZIS
+11 ; DBIA 10089 ^%ZISC
+12 ; DBIA 10063 ^%ZTLOAD
+13 ; DBIA 148 PATIENT^ORU1
+14 ; DBIA 183 DFN^PSOSD1
+15 ; DBIA 10141 $$VERSION^XPDUTL
+16 ;
MAIN ; Control branching
+1 NEW C,I,GMTYP,VADM,VAROOT,ZTRTN,GMPSAP
+2 KILL DIROUT,DUOUT
+3 FOR
Begin DoDot:1
+4 DO SELTYP
IF $DATA(DUOUT)!$DATA(DIROUT)!($DATA(GMTYP)'>9)
QUIT
+5 NEW GMPAT,GMP
+6 FOR
IF $DATA(DIROUT)
QUIT
Begin DoDot:2
+7 KILL GMP,GMPAT
+8 IF +($GET(ORVP))
SET GMPAT(1)=+($GET(ORVP))
+9 IF '$TEST
FOR
IF $DATA(DIROUT)
QUIT
KILL ^XUTL("OR",$JOB,"ORU"),^("ORV"),^("ORW"),^("ORLP"),GMP
DO PTPC
IF $SELECT($DATA(DUOUT)
QUIT
Begin DoDot:3
+10 WRITE !!,"Another patient(s) can be selected."
End DoDot:3
+11 IF $DATA(DUOUT)!$DATA(DIROUT)!(+$DATA(GMPAT)'>0)
QUIT
+12 NEW GMTSPX1,GMTSPX2
+13 IF +$GET(GMRANGE)>0
DO GETRANGE^GMTSU(.GMTSPX2,.GMTSPX1)
IF $GET(GMTSPX1)=""!($GET(GMTSPX2)="")
QUIT
+14 IF $DATA(DUOUT)!$DATA(DIROUT)
QUIT
+15 DO RESUB(.GMPAT)
+16 SET GMPSAP=$$RXAP^GMTSPD2
IF $DATA(DIROUT)!$DATA(DUOUT)!$DATA(DTOUT)
QUIT
+17 SET ZTRTN="PQ^GMTSDVR"
+18 DO HSOUT
End DoDot:2
IF $DATA(DUOUT)!$DATA(DIROUT)!(+$DATA(GMPAT)'>0)!(+($GET(ORVP))>0)
QUIT
End DoDot:1
IF $DATA(DUOUT)!$DATA(DIROUT)!($DATA(GMTYP)'>9)
QUIT
+19 KILL ^XUTL("OR",$JOB,"ORU"),^("ORV"),^("ORW"),^("ORLP")
+20 QUIT
PTPC ; Combined Patient/Patient Copy
+1 NEW GMTSPRO,GMTSVER
SET GMTSVER=+($$VERSION^XPDUTL("OR"))
SET GMTSPRO=+($$PROK^GMTSU("ORU1",11))
+2 IF GMTSVER>2.9&(GMTSPRO)
DO PATIENT^ORU1(.GMP,,"I $P($G(^(""OOS"")),""^"")")
+3 IF GMTSVER'>2.9!('GMTSPRO)
DO PATIENT^ORU1(.GMP)
DO PATCOPY^GMTSDVR(.GMP,.GMPAT)
+4 QUIT
PATCOPY(GMP,GMPAT) ; Copies patients from GMP to GMPAT array
+1 NEW IFN,GMDFN
+2 SET IFN=0
+3 ; GMPAT(NAME,GMDFN) - alphabetic order by patient
+4 FOR
SET IFN=$ORDER(GMP(IFN))
IF IFN'>0
QUIT
Begin DoDot:1
+5 SET GMDFN=+$GET(GMP(IFN))
+6 ; Get name from ^DPT to prevent duplicates
+7 SET GMPAT($PIECE($GET(^DPT(GMDFN,0)),U),+GMDFN)=+GMDFN
End DoDot:1
+8 QUIT
RESUB(GMP) ; Resubscript GMP Array
+1 ; Subscripts in GMP array are converted to numeric
+2 NEW NAME,GMDFN,CNT
+3 SET CNT=0
SET NAME=""
+4 FOR
SET NAME=$ORDER(GMP(NAME))
IF NAME']""
QUIT
Begin DoDot:1
+5 SET GMDFN=0
+6 FOR
SET GMDFN=$ORDER(GMP(NAME,GMDFN))
IF GMDFN'>0
QUIT
Begin DoDot:2
+7 SET CNT=CNT+1
+8 SET GMP(CNT)=GMP(NAME,GMDFN)
+9 KILL GMP(NAME,GMDFN)
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
ENXQ ; External call for tasked HS print
+1 ;
+2 ; Input: GMTSTYP=Record # of HS type in file 142
+3 ; DFN=Record # of patient in file 2
+4 ; GMTSPX1=Optional internal FM ending date
+5 ; GMTSPX2=Optional internal FM beginning date
+6 ;
+7 ; NOTE: Optional date range variables are both
+8 ; required if a date range is desired.
+9 ;
+10 ; To call from TaskMan:
+11 ; S ZTRTN="ENXQ^GMTSDVR"
+12 ; S ZTSAVE("GMTSTYP")=""
+13 ; S ZTSAVE("DFN")=""
+14 ; D ^%ZTLOAD
+15 DO ENX(DFN,GMTSTYP,$GET(GMTSPX2),$GET(GMTSPX1))
+16 QUIT
+17 ;
ENX(DFN,GMTSTYP,GMTSPX2,GMTSPX1) ; External call to print a Health Summary
+1 ;
+2 ; Input: GMTSTYP=Record # of HS type in file 142
+3 ; DFN=Record # of patient in file 2
+4 ; GMTSPX1=Optional internal FM ending date
+5 ; GMTSPX2=Optional internal FM beginning date
+6 ;
+7 ; NOTE: Optional date range variables are both
+8 ; required if a date range is desired.
+9 ;
+10 NEW DI,DX,DY,GMQUIT,GMTYP,GMPAT,VADM,VAIN,VAROOT
+11 FOR
IF ($DATA(^GMT(142,+GMTSTYP,1))>9)&$DATA(^DPT(DFN))!+$GET(GMQUIT)
QUIT
Begin DoDot:1
+12 IF $DATA(^GMT(142,+GMTSTYP,1))'>9
Begin DoDot:2
+13 IF $DATA(ZTQUEUED)
SET GMQUIT=1
QUIT
+14 WRITE !?3,"Invalid HEALTH SUMMARY TYPE."
DO SELTYP
SET GMTSTYP=+$GET(GMTYP(1))
End DoDot:2
+15 IF '$DATA(^DPT(DFN))
Begin DoDot:2
+16 IF $DATA(ZTQUEUED)
SET GMQUIT=1
QUIT
+17 WRITE !?3,"Invalid PATIENT ID."
DO PATIENT^ORU1(.GMPAT)
SET DFN=+$GET(GMPAT(1))
End DoDot:2
End DoDot:1
+18 IF +$GET(GMQUIT)
QUIT
+19 IF $DATA(GMTYP)'>9
SET GMTYP(0)=1
SET GMTYP(1)=+$GET(GMTSTYP)_U_$PIECE($GET(^GMT(142,+GMTSTYP,0)),U)
+20 IF $DATA(GMPAT)'>9
SET GMPAT=1
SET GMPAT(0)=1
SET GMPAT(1)=DFN_U_$PIECE($GET(^DPT(DFN,0)),U)
+21 DO PQ
+22 QUIT
SELTYP ; Select Health Summary Type(s)
+1 NEW DIC,X,Y
+2 SET DIC=142
SET DIC("A")="Select Health Summary Type: "
SET DIC(0)="AEMQZ"
+3 SET DIC("S")="I $P(^(0),U)'=""GMTS HS ADHOC OPTION"""
+4 IF $DATA(GMTYP)<10
SET DIC("B")=$SELECT($DATA(^DISV(DUZ,"^GMT(142,"))=10:$GET(^DISV(DUZ,"^GMT(142,",$ORDER(^("^GMT(142,",0)))),1:$PIECE($GET(^GMT(142,+$GET(^DISV(DUZ,"^GMT(142,")),0)),U))
+5 KILL GMTYP
SET Y=$$TYPE^GMTSULT
IF +Y'>0
QUIT
+6 IF $SELECT($DATA(^GMT(142,+Y,1,0))=0:1,$ORDER(^(0))'>0:1,1:0)
WRITE !,"The Summary Type "_$PIECE(Y,U,2)_" includes no components...Please choose another",!
QUIT
+7 SET GMTYP(0)=1
SET GMTYP(1)=Y_U_$PIECE(Y,U,2)_U_$PIECE(Y,U,2)_U_$PIECE(Y,U,2)
+8 QUIT
PQ ; Queued subroutine for HS by patient
+1 NEW DFN,GMTI,GMTS,GMTS1,GMTS2,GMTSAGE,GMTSDOB,GMTSDTM,GMTSLO,GMTSLPG,GMTSPNM
+2 NEW GMTSRB,GMTSSN,GMTSTOF,GMTSTYP,GMTSTITL,GMTSWARD,GMTJ,I,IX0,J,M4,P17,SEX
+3 NEW GMTSPHDR,TRFAC,VAERR,VAIN
+4 SET GMTI=0
FOR
SET GMTI=$ORDER(GMTYP(GMTI))
IF GMTI'>0!$DATA(DIROUT)
QUIT
Begin DoDot:1
+5 NEW GMTSEG,GMTSEGC,GMTSEGI
+6 SET GMTSTYP=+$GET(GMTYP(GMTI))
SET GMTSTITL=$GET(^GMT(142,+GMTSTYP,"T"))
+7 IF '$LENGTH(GMTSTITL)
SET GMTSTITL=$PIECE(GMTYP(GMTI),U,2)
+8 DO LOADSEG
+9 SET GMTJ=0
FOR
SET GMTJ=$ORDER(GMPAT(GMTJ))
IF GMTJ'>0!$DATA(DIROUT)
QUIT
Begin DoDot:2
+10 SET DFN=+$GET(GMPAT(GMTJ))
+11 NEW GMDUOUT
+12 DO EN^GMTS1
+13 IF $DATA(DIROUT)!+$GET(GMDUOUT)
QUIT
+14 DO ACTPROF^GMTSDVR(DFN)
End DoDot:2
End DoDot:1
+15 QUIT
LOADSEG ; Load Enabled Components into GMTSEG Array
+1 NEW GMTI,GMTJ,GMX
+2 SET (GMTI,GMTJ)=0
FOR
SET GMTJ=$ORDER(^GMT(142,GMTSTYP,1,GMTJ))
IF GMTJ'>0
QUIT
SET GMX=^(GMTJ,0)
Begin DoDot:1
+3 SET GMTI=GMTI+1
SET GMTSEG(GMTI)=GMX
SET GMTSEGI($PIECE(GMX,U,2))=GMTI
DO SELFILE
End DoDot:1
+4 SET GMTSEGC=GMTI
+5 QUIT
SELFILE ; Get Selection item information for GMTSEG(
+1 NEW GMTK
SET GMTK=0
FOR
SET GMTK=$ORDER(^GMT(142,GMTSTYP,1,GMTJ,1,GMTK))
IF GMTK'>0
QUIT
Begin DoDot:1
+2 NEW GMTSE,GMTSR,GMTSF
SET GMTSE=^(GMTK,0)
SET GMTSR=U_$PIECE(GMTSE,";",2)
IF GMTSR="^"
QUIT
+3 SET GMTSF=+$PIECE(@(GMTSR_"0)"),U,2)
IF +GMTSF=0
QUIT
+4 SET GMTSEG(GMTI,GMTSF,GMTK)=$PIECE(GMTSE,";")
SET GMTSEG(GMTI,GMTSF,0)=GMTSR
End DoDot:1
+5 QUIT
HSOUT ; Output summary, with device control
+1 ; Call with: ZTRTN
+2 IF $DATA(^XUSEC("GMTS VIEW ONLY",DUZ))
DO @ZTRTN
QUIT
+3 NEW %ZIS,IOP
+4 SET %ZIS="PQ"
DO ^%ZIS
IF POP
QUIT
+5 IF $DATA(IO("Q"))
GOTO QUE
NOQUE ; Do Not Queue Output
+1 DO @ZTRTN
DO ^%ZISC
+2 QUIT
QUE ; Queue output
+1 NEW %,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTSK
+2 IF '$DATA(ZTRTN)
QUIT
KILL IO("Q"),ZTSAVE
FOR %="DFN","GM*","ENTRY","O*"
SET ZTSAVE(%)=""
+3 SET ZTDESC="HEALTH SUMMARY"
SET ZTIO=ION
+4 DO ^%ZTLOAD
WRITE !,$SELECT($DATA(ZTSK):"Request Queued!",1:"Request Cancelled!")
+5 KILL ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
DO ^%ZISC
+6 SET IOP="HOME"
DO ^%ZIS
+7 QUIT
ACTPROF(GMDFN) ; Print Action Profile for Patient
+1 NEW DFN,PSTYPE,PSONOPG,PSOPAR,PSOINST
+2 IF +$GET(GMPSAP)
Begin DoDot:1
+3 SET (PSTYPE,PSONOPG)=1
SET DFN=GMDFN
+4 SET $PIECE(PSOPAR,U)=$SELECT($PIECE($GET(^GMT(142.99,1,0)),U,5)="Y":1,1:0)
+5 SET PSOINST=$SELECT(+$GET(PSOINST):PSOINST,1:+$PIECE($GET(^DIC(4,+$PIECE($GET(^XMB(1,1,"XUS")),U,17),99)),U))
+6 DO DFN^PSOSD1
+7 SET DFN=GMDFN
+8 ; Reset DFN because ^PSOSD1 call kills it
+9 DO PAGE^GMTSPL
End DoDot:1
