- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSDVR 6791 printed Jan 18, 2025@02:58:42 Page 2
- 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