GMTS ; SLC/KER - Health Summary Main Routine ; 02/27/2002
;;2.7;Health Summary;**16,24,28,30,31,35,49**;Oct 20, 1995
;
; External References
; DBIA 510 ^DISV(
; DBIA 10035 ^DPT(
; DBIA 10076 ^XUSEC("GMTS VIEW ONLY"
; DBIA 2160 ^XUTL("OR"
; DBIA 10086 ^%ZIS
; DBIA 10089 ^%ZISC
; DBIA 10063 ^%ZTLOAD
; DBIA 148 PATIENT^ORU1
; DBIA 10141 $$VERSION^XPDUTL
;
MAIN ; Controls branching
;
; GMTSPXGO & GMRANGE are set in 2 calling
; options, They aren't meant to be used together.
;
I +$G(GMTSPXGO)'>0,$L($T(PATIENT^ORU1)),($$VERSION^XPDUTL("OR")>2.19) D MAIN^GMTSDVR Q
N DIROUT,DUOUT,ZTRTN,GMTSPX1,GMTSPX2,GMNAME,GMPSAP
S GMTSTYP=0 K DIC,DIROUT,DUOUT
S DIC("B")=$P($G(^GMT(142,+$G(^DISV(+$G(DUZ),"^GMT(142,")),0)),U)
F Q:$D(DIROUT)!$D(DUOUT) D SELTYP Q:GMTSTYP'>0!$D(DIROUT)!$D(DUOUT) D
. N GMPAT,DFN,GMTSMULT
. F Q:$D(DIROUT) D Q:$D(DIROUT)!$D(DUOUT)!(+$D(GMPAT)'>0)!+$G(ORVP)
. . K GMPAT,DFN
. . I +$G(ORVP) D
. . . S (DFN,GMPAT(1))=+ORVP,GMNAME=$P($G(^DPT(+DFN,0)),U) Q:GMNAME="" S GMPATT(GMNAME,DFN)="",(GMTSPX1,GMTSPX2)=""
. . . W !!,"For patient ",GMNAME," please answer the following."
. . . I +$G(GMTSPXGO)>0 D MENU^GMTSPXU2(DFN,.GMTSPX2,.GMTSPX1)
. . . I $G(GMTSPX1)']""!($G(GMTSPX2)']"") S DIROUT=1 K GMPAT,GMPATT Q
. . . Q:$D(DIROUT) S GMPAT(GMNAME_(9999999-GMTSPX1),+DFN)=+DFN_U_$G(GMTSPX1)_U_$G(GMTSPX2)
. . I '(+($G(ORVP))) F Q:$D(DIROUT) K GMPATT D SELPT Q:$D(DIROUT)!('$D(GMPATT)) S GMNAME="" F S GMNAME=$O(GMPATT(GMNAME)) Q:GMNAME=""!$D(DIROUT) F DFN=0:0 S DFN=$O(GMPATT(GMNAME,DFN)) Q:DFN="" D Q:$D(DIROUT)
. . . S (GMTSPX1,GMTSPX2)="" W !!,"For patient ",GMNAME," please answer the following."
. . . I +$G(GMTSPXGO)>0 D MENU^GMTSPXU2(DFN,.GMTSPX2,.GMTSPX1) I $G(GMTSPX1)']""!($G(GMTSPX2)']"") Q
. . . Q:$D(DIROUT)
. . . S GMPAT(GMNAME_(9999999-GMTSPX1),+DFN)=+DFN_U_$G(GMTSPX1)_U_$G(GMTSPX2)
. . Q:$D(DIROUT)!(+$D(GMPAT)'>0)
. . I +$G(GMRANGE)>0 D GETRANGE^GMTSU(.GMTSPX1,.GMTSPX2) Q:$G(GMTSPX1)=""!($G(GMTSPX2)="")
. . Q:$D(DIROUT)
. . D RESUB^GMTSDVR(.GMPAT)
. . S GMPSAP=$$RXAP^GMTSPD2 Q:$D(DIROUT)!$D(DTOUT)
. . S ZTRTN="PQ^GMTS"
. . D HSOUT^GMTSDVR,END W !
K GMTSTYP,GMTSTITL,GMTSEG,GMTSEGI,GMTSEGC,GMX,DFN,X,Y,I,GMP,GMPATT
Q
SELTYP ; Select a Health Summary Type for printing
Q:GMTSTYP=-1 S DIC=142,DIC("A")="Select Health Summary Type: ",DIC(0)="AEQM",DIC("S")="I $P(^(0),U)'=""GMTS HS ADHOC OPTION"""
S Y=$$TYPE^GMTSULT K DIC S GMTSTYP=+Y,GMTSTITL=$S($D(^GMT(142,+Y,"T")):^("T"),1:"") S:GMTSTITL="" GMTSTITL=$P(Y,"^",2)
I GMTSTYP>0,$S($D(^GMT(142,GMTSTYP,1,0))=0:1,$O(^(0))'>0:1,1:0) W !,"This Summary Type includes no components...Please choose another." G SELTYP
SELTYP1 ; Get each component record
K GMTSEG,GMTSEGI S (GMI,S1)=0 F S S1=$O(^GMT(142,GMTSTYP,1,S1)) Q:'S1 S GMX=^(S1,0) D LOADSEG
S GMTSEGC=GMI K S1,S2,GMI
Q
LOADSEG ; Load enabled components into GMTSEG array
S GMTS0=^GMT(142.1,$P(GMX,"^",2),0)
S GMI=GMI+1,GMTSEG(GMI)=GMX,GMTSEGI($P(GMX,U,2))=GMI D SELFILE
Q
SELPT ; Select a patient
N DUOUT,GMTSPRO,GMTSVER K ^XUTL("OR",$J,"ORU"),^("ORV"),^("ORW"),^("ORLP"),GMP
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,.GMPATT)
Q
SELFILE ; Load Selection Items in GMTSEG( array
N SF,SR,S2 S S2=0 F S S2=$O(^GMT(142,GMTSTYP,1,S1,1,S2)) Q:'S2 D
. S ENTRY=^(S2,0),SR=U_$P(ENTRY,";",2) Q:SR="^"
. S SF=+$P(@(SR_"0)"),U,2) Q:+SF=0
. S GMTSEG(GMI,SF,S2)=$P(ENTRY,";"),GMTSEG(GMI,SF,0)=SR
Q
PQ ; Queued subroutine for HS by patient
N DFN,GMTS,GMTS1,GMTS2,GMTSAGE,GMTSDOB,GMTSDTM,GMTSLO,GMTSLPG,GMTSPNM
N GMTSRB,GMTSSN,GMTSTOF,GMTSWARD,GMTJ,I,IX0,J,M4,P17,SEX
N TRFAC,VAERR,VAIN
S GMTJ=0 F S GMTJ=$O(GMPAT(GMTJ)) Q:GMTJ'>0!$D(DIROUT) D
. S DFN=+$G(GMPAT(GMTJ))
. I +$G(GMTSPXGO)>0 S GMTSPX1=$P($G(GMPAT(GMTJ)),U,2) D
. . S GMTSPX2=$P($G(GMPAT(GMTJ)),U,3)
. . I +GMTSPX1'>0!+GMTSPX2'>0 K GMTSPX1,GMTSPX2
. N GMDUOUT
. D EN^GMTS1
. Q:$D(DIROUT)!+$G(GMDUOUT)
. D ACTPROF^GMTSDVR(DFN)
Q
HSOUT ; Output Summary, with DEVICE handling
K ZTSK
I $D(^XUSEC("GMTS VIEW ONLY",DUZ)) D EN^GMTS1 Q
K IOP S %ZIS="PQ" D ^%ZIS Q:POP
G:$D(IO("Q")) QUE
NOQUE ; Print non-queued output to selected device
D EN^GMTS1
D ^%ZISC
Q
QUE ; Call TaskMan to Queue output
K IO("Q"),ZTSAVE F %="DFN","GMTS*","ENTRY" S ZTSAVE(%)=""
S ZTRTN="EN^GMTS1",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
END ; Clean up environmental variables and EXIT Health Summary
K %T,DIC,GMTS,GMTSLO,GMTSPNM,GMTSRB,GMTSWARD,GMTSDOB,DIC,X,Y,VA,VAIN,VAINDT,VADM,VAEL,VAPA,VAERR,GMTSSN,GMTS0,GMTS1,GMTS2
K GMTSAGE,GMTSTIM,GMTSEGN,GMTSEGH,GMTSEGL,GMTSHDR,GMTSNPG,GMTSPG,GMTSQIT,GMTSX,ENTRY,Z1,GMTSDTM,GMTSLOCK,GMTSLPG,SEX,POP,C,GMTSTOF
Q
ENCWA ; Entry point printing components
;
; GMTSPRM can be set to any component abbreviations
; except ones that require selection items. Needs
; to be valid component abbreviation from the "C"
; x-ref of File 142.1.
;
; Call with DFN, GMTSPRM="CD,CN,CW,ADR", GMTSTITL="TITLE"
;
; GMTSPX1=Optional FM date for ending date
; GMTSPX2=Optional FM date for beginning date
;
; NOTE: Optional date range variables are both
; required if a date range is desired.
;
N GMI,GMJ,GMTSEG,GMTSEGI,GMTSEGC
S GMTS1="9999999",GMTS2="6666666",GMI=0,GMTSPNF=1
I '$D(GMTSPRM) W !,"The parameter GMTSPRM is undefined.",! Q
I '$D(GMTSTITL) W !,"The parameter GMTSTITL is undefined.",! Q
I '+$G(DFN) W !,"The parameter DFN is undefined.",! Q
F GMJ=1:1:$L(GMTSPRM,",") S ABB=$P(GMTSPRM,",",GMJ) D LOAD Q:GMJ=-1
S GMTSEGC=GMI K ABB,IFN
D EN^GMTS1
D END K GMTSEG,GMTSEGI,GMTSEGC,GMTSTITL,GMTSPRM,GMTSPNF
Q
LOAD ; Load GMTSEG() using GMTSPRM abbreviations
S IFN=$O(^GMT(142.1,"C",ABB,"")) Q:IFN=""
S GMI=GMI+1,GMTSEG(GMI)=GMI_"^"_IFN,GMTSEGI(IFN)=GMI
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTS 6278 printed Dec 13, 2024@01:56:51 Page 2
GMTS ; SLC/KER - Health Summary Main Routine ; 02/27/2002
+1 ;;2.7;Health Summary;**16,24,28,30,31,35,49**;Oct 20, 1995
+2 ;
+3 ; External References
+4 ; DBIA 510 ^DISV(
+5 ; DBIA 10035 ^DPT(
+6 ; DBIA 10076 ^XUSEC("GMTS VIEW ONLY"
+7 ; DBIA 2160 ^XUTL("OR"
+8 ; DBIA 10086 ^%ZIS
+9 ; DBIA 10089 ^%ZISC
+10 ; DBIA 10063 ^%ZTLOAD
+11 ; DBIA 148 PATIENT^ORU1
+12 ; DBIA 10141 $$VERSION^XPDUTL
+13 ;
MAIN ; Controls branching
+1 ;
+2 ; GMTSPXGO & GMRANGE are set in 2 calling
+3 ; options, They aren't meant to be used together.
+4 ;
+5 IF +$GET(GMTSPXGO)'>0
IF $LENGTH($TEXT(PATIENT^ORU1))
IF ($$VERSION^XPDUTL("OR")>2.19)
DO MAIN^GMTSDVR
QUIT
+6 NEW DIROUT,DUOUT,ZTRTN,GMTSPX1,GMTSPX2,GMNAME,GMPSAP
+7 SET GMTSTYP=0
KILL DIC,DIROUT,DUOUT
+8 SET DIC("B")=$PIECE($GET(^GMT(142,+$GET(^DISV(+$GET(DUZ),"^GMT(142,")),0)),U)
+9 FOR
if $DATA(DIROUT)!$DATA(DUOUT)
QUIT
DO SELTYP
if GMTSTYP'>0!$DATA(DIROUT)!$DATA(DUOUT)
QUIT
Begin DoDot:1
+10 NEW GMPAT,DFN,GMTSMULT
+11 FOR
if $DATA(DIROUT)
QUIT
Begin DoDot:2
+12 KILL GMPAT,DFN
+13 IF +$GET(ORVP)
Begin DoDot:3
+14 SET (DFN,GMPAT(1))=+ORVP
SET GMNAME=$PIECE($GET(^DPT(+DFN,0)),U)
if GMNAME=""
QUIT
SET GMPATT(GMNAME,DFN)=""
SET (GMTSPX1,GMTSPX2)=""
+15 WRITE !!,"For patient ",GMNAME," please answer the following."
+16 IF +$GET(GMTSPXGO)>0
DO MENU^GMTSPXU2(DFN,.GMTSPX2,.GMTSPX1)
+17 IF $GET(GMTSPX1)']""!($GET(GMTSPX2)']"")
SET DIROUT=1
KILL GMPAT,GMPATT
QUIT
+18 if $DATA(DIROUT)
QUIT
SET GMPAT(GMNAME_(9999999-GMTSPX1),+DFN)=+DFN_U_$GET(GMTSPX1)_U_$GET(GMTSPX2)
End DoDot:3
+19 IF '(+($GET(ORVP)))
FOR
if $DATA(DIROUT)
QUIT
KILL GMPATT
DO SELPT
if $DATA(DIROUT)!('$DATA(GMPATT))
QUIT
SET GMNAME=""
FOR
SET GMNAME=$ORDER(GMPATT(GMNAME))
if GMNAME=""!$DATA(DIROUT)
QUIT
FOR DFN=0:0
SET DFN=$ORDER(GMPATT(GMNAME,DFN))
if DFN=""
QUIT
Begin DoDot:3
+20 SET (GMTSPX1,GMTSPX2)=""
WRITE !!,"For patient ",GMNAME," please answer the following."
+21 IF +$GET(GMTSPXGO)>0
DO MENU^GMTSPXU2(DFN,.GMTSPX2,.GMTSPX1)
IF $GET(GMTSPX1)']""!($GET(GMTSPX2)']"")
QUIT
+22 if $DATA(DIROUT)
QUIT
+23 SET GMPAT(GMNAME_(9999999-GMTSPX1),+DFN)=+DFN_U_$GET(GMTSPX1)_U_$GET(GMTSPX2)
End DoDot:3
if $DATA(DIROUT)
QUIT
+24 if $DATA(DIROUT)!(+$DATA(GMPAT)'>0)
QUIT
+25 IF +$GET(GMRANGE)>0
DO GETRANGE^GMTSU(.GMTSPX1,.GMTSPX2)
if $GET(GMTSPX1)=""!($GET(GMTSPX2)="")
QUIT
+26 if $DATA(DIROUT)
QUIT
+27 DO RESUB^GMTSDVR(.GMPAT)
+28 SET GMPSAP=$$RXAP^GMTSPD2
if $DATA(DIROUT)!$DATA(DTOUT)
QUIT
+29 SET ZTRTN="PQ^GMTS"
+30 DO HSOUT^GMTSDVR
DO END
WRITE !
End DoDot:2
if $DATA(DIROUT)!$DATA(DUOUT)!(+$DATA(GMPAT)'>0)!+$GET(ORVP)
QUIT
End DoDot:1
+31 KILL GMTSTYP,GMTSTITL,GMTSEG,GMTSEGI,GMTSEGC,GMX,DFN,X,Y,I,GMP,GMPATT
+32 QUIT
SELTYP ; Select a Health Summary Type for printing
+1 if GMTSTYP=-1
QUIT
SET DIC=142
SET DIC("A")="Select Health Summary Type: "
SET DIC(0)="AEQM"
SET DIC("S")="I $P(^(0),U)'=""GMTS HS ADHOC OPTION"""
+2 SET Y=$$TYPE^GMTSULT
KILL DIC
SET GMTSTYP=+Y
SET GMTSTITL=$SELECT($DATA(^GMT(142,+Y,"T")):^("T"),1:"")
if GMTSTITL=""
SET GMTSTITL=$PIECE(Y,"^",2)
+3 IF GMTSTYP>0
IF $SELECT($DATA(^GMT(142,GMTSTYP,1,0))=0:1,$ORDER(^(0))'>0:1,1:0)
WRITE !,"This Summary Type includes no components...Please choose another."
GOTO SELTYP
SELTYP1 ; Get each component record
+1 KILL GMTSEG,GMTSEGI
SET (GMI,S1)=0
FOR
SET S1=$ORDER(^GMT(142,GMTSTYP,1,S1))
if 'S1
QUIT
SET GMX=^(S1,0)
DO LOADSEG
+2 SET GMTSEGC=GMI
KILL S1,S2,GMI
+3 QUIT
LOADSEG ; Load enabled components into GMTSEG array
+1 SET GMTS0=^GMT(142.1,$PIECE(GMX,"^",2),0)
+2 SET GMI=GMI+1
SET GMTSEG(GMI)=GMX
SET GMTSEGI($PIECE(GMX,U,2))=GMI
DO SELFILE
+3 QUIT
SELPT ; Select a patient
+1 NEW DUOUT,GMTSPRO,GMTSVER
KILL ^XUTL("OR",$JOB,"ORU"),^("ORV"),^("ORW"),^("ORLP"),GMP
+2 SET GMTSVER=+($$VERSION^XPDUTL("OR"))
SET GMTSPRO=+($$PROK^GMTSU("ORU1",11))
+3 if +GMTSVER>2.9&(GMTSPRO)
DO PATIENT^ORU1(.GMP,,"I $P($G(^(""OOS"")),""^"")")
+4 if +GMTSVER'>2.9!('GMTSPRO)
DO PATIENT^ORU1(.GMP)
+5 DO PATCOPY^GMTSDVR(.GMP,.GMPATT)
+6 QUIT
SELFILE ; Load Selection Items in GMTSEG( array
+1 NEW SF,SR,S2
SET S2=0
FOR
SET S2=$ORDER(^GMT(142,GMTSTYP,1,S1,1,S2))
if 'S2
QUIT
Begin DoDot:1
+2 SET ENTRY=^(S2,0)
SET SR=U_$PIECE(ENTRY,";",2)
if SR="^"
QUIT
+3 SET SF=+$PIECE(@(SR_"0)"),U,2)
if +SF=0
QUIT
+4 SET GMTSEG(GMI,SF,S2)=$PIECE(ENTRY,";")
SET GMTSEG(GMI,SF,0)=SR
End DoDot:1
+5 QUIT
PQ ; Queued subroutine for HS by patient
+1 NEW DFN,GMTS,GMTS1,GMTS2,GMTSAGE,GMTSDOB,GMTSDTM,GMTSLO,GMTSLPG,GMTSPNM
+2 NEW GMTSRB,GMTSSN,GMTSTOF,GMTSWARD,GMTJ,I,IX0,J,M4,P17,SEX
+3 NEW TRFAC,VAERR,VAIN
+4 SET GMTJ=0
FOR
SET GMTJ=$ORDER(GMPAT(GMTJ))
if GMTJ'>0!$DATA(DIROUT)
QUIT
Begin DoDot:1
+5 SET DFN=+$GET(GMPAT(GMTJ))
+6 IF +$GET(GMTSPXGO)>0
SET GMTSPX1=$PIECE($GET(GMPAT(GMTJ)),U,2)
Begin DoDot:2
+7 SET GMTSPX2=$PIECE($GET(GMPAT(GMTJ)),U,3)
+8 IF +GMTSPX1'>0!+GMTSPX2'>0
KILL GMTSPX1,GMTSPX2
End DoDot:2
+9 NEW GMDUOUT
+10 DO EN^GMTS1
+11 if $DATA(DIROUT)!+$GET(GMDUOUT)
QUIT
+12 DO ACTPROF^GMTSDVR(DFN)
End DoDot:1
+13 QUIT
HSOUT ; Output Summary, with DEVICE handling
+1 KILL ZTSK
+2 IF $DATA(^XUSEC("GMTS VIEW ONLY",DUZ))
DO EN^GMTS1
QUIT
+3 KILL IOP
SET %ZIS="PQ"
DO ^%ZIS
if POP
QUIT
+4 if $DATA(IO("Q"))
GOTO QUE
NOQUE ; Print non-queued output to selected device
+1 DO EN^GMTS1
+2 DO ^%ZISC
+3 QUIT
QUE ; Call TaskMan to Queue output
+1 KILL IO("Q"),ZTSAVE
FOR %="DFN","GMTS*","ENTRY"
SET ZTSAVE(%)=""
+2 SET ZTRTN="EN^GMTS1"
SET ZTDESC="HEALTH SUMMARY"
SET ZTIO=ION
+3 DO ^%ZTLOAD
WRITE !,$SELECT($DATA(ZTSK):"Request Queued!",1:"Request Cancelled!")
+4 KILL ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
DO ^%ZISC
+5 SET IOP="HOME"
DO ^%ZIS
+6 QUIT
END ; Clean up environmental variables and EXIT Health Summary
+1 KILL %T,DIC,GMTS,GMTSLO,GMTSPNM,GMTSRB,GMTSWARD,GMTSDOB,DIC,X,Y,VA,VAIN,VAINDT,VADM,VAEL,VAPA,VAERR,GMTSSN,GMTS0,GMTS1,GMTS2
+2 KILL GMTSAGE,GMTSTIM,GMTSEGN,GMTSEGH,GMTSEGL,GMTSHDR,GMTSNPG,GMTSPG,GMTSQIT,GMTSX,ENTRY,Z1,GMTSDTM,GMTSLOCK,GMTSLPG,SEX,POP,C,GMTSTOF
+3 QUIT
ENCWA ; Entry point printing components
+1 ;
+2 ; GMTSPRM can be set to any component abbreviations
+3 ; except ones that require selection items. Needs
+4 ; to be valid component abbreviation from the "C"
+5 ; x-ref of File 142.1.
+6 ;
+7 ; Call with DFN, GMTSPRM="CD,CN,CW,ADR", GMTSTITL="TITLE"
+8 ;
+9 ; GMTSPX1=Optional FM date for ending date
+10 ; GMTSPX2=Optional FM date for beginning date
+11 ;
+12 ; NOTE: Optional date range variables are both
+13 ; required if a date range is desired.
+14 ;
+15 NEW GMI,GMJ,GMTSEG,GMTSEGI,GMTSEGC
+16 SET GMTS1="9999999"
SET GMTS2="6666666"
SET GMI=0
SET GMTSPNF=1
+17 IF '$DATA(GMTSPRM)
WRITE !,"The parameter GMTSPRM is undefined.",!
QUIT
+18 IF '$DATA(GMTSTITL)
WRITE !,"The parameter GMTSTITL is undefined.",!
QUIT
+19 IF '+$GET(DFN)
WRITE !,"The parameter DFN is undefined.",!
QUIT
+20 FOR GMJ=1:1:$LENGTH(GMTSPRM,",")
SET ABB=$PIECE(GMTSPRM,",",GMJ)
DO LOAD
if GMJ=-1
QUIT
+21 SET GMTSEGC=GMI
KILL ABB,IFN
+22 DO EN^GMTS1
+23 DO END
KILL GMTSEG,GMTSEGI,GMTSEGC,GMTSTITL,GMTSPRM,GMTSPNF
+24 QUIT
LOAD ; Load GMTSEG() using GMTSPRM abbreviations
+1 SET IFN=$ORDER(^GMT(142.1,"C",ABB,""))
if IFN=""
QUIT
+2 SET GMI=GMI+1
SET GMTSEG(GMI)=GMI_"^"_IFN
SET GMTSEGI(IFN)=GMI
+3 QUIT
