ORPRS13 ; slc/dcm,JER - Health Summary Report & Driver (HSR&D) ;6/10/97 15:52
;;3.0;ORDER ENTRY/RESULTS REPORTING;**11**;Dec 17, 1997
MAIN ;Happy Birthday Elvis!!!
N C,I,GMTYP,VAROOT,ZTRTN,GMTI,ORVP
K ^XUTL("OR",$J,"ORU"),^("ORV"),^("ORW")
D:$D(ORSCPAT)'>9 P^ORPRS01
Q:$D(DUOUT)!$D(DIROUT)!'$D(ORSCPAT)
D SELTYP
Q:$D(DUOUT)!$D(DIROUT)!'$D(GMTYP)
S ZTRTN="PQ^ORPRS13",GMTI=0
F S GMTI=$O(ORSCPAT(GMTI)) Q:GMTI'>0 S ORVP=+ORSCPAT(GMTI) D HSOUT^GMTSDVR
K ^XUTL("OR",$J,"ORU"),^("ORV"),^("ORW")
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))
I $G(DIC("B"))="GMTS HS ADHOC OPTION" K DIC("B")
K GMTYP
D ^DIC
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 TRFAC,VAERR,VAIN,VAROOT
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 DFN=+ORVP
. D EN^GMTS1
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,ITEM,FST
S GMTK=0,FST=1
F S GMTK=$O(^GMT(142,GMTSTYP,1,GMTJ,1,GMTK)) Q:GMTK'>0 S ITEM=^(GMTK,0),GMTSEG(GMTI,+$P(@(U_$P(ITEM,";",2)_"0)"),U,2),GMTK)=$P(ITEM,";") I $G(FST) S GMTSEG(GMTI,+$P(@(U_$P(ITEM,";",2)_"0)"),U,2),0)=U_$P(ITEM,";",2) K FST
Q
ADHOC ;Do adhoc
S GMTSTITL="AD HOC"
S DFN=+ORVP
D EN^GMTS1
K GMTSEG,GMTSEGI
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORPRS13 2276 printed Sep 23, 2025@20:09:19 Page 2
ORPRS13 ; slc/dcm,JER - Health Summary Report & Driver (HSR&D) ;6/10/97 15:52
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**11**;Dec 17, 1997
MAIN ;Happy Birthday Elvis!!!
+1 NEW C,I,GMTYP,VAROOT,ZTRTN,GMTI,ORVP
+2 KILL ^XUTL("OR",$JOB,"ORU"),^("ORV"),^("ORW")
+3 if $DATA(ORSCPAT)'>9
DO P^ORPRS01
+4 if $DATA(DUOUT)!$DATA(DIROUT)!'$DATA(ORSCPAT)
QUIT
+5 DO SELTYP
+6 if $DATA(DUOUT)!$DATA(DIROUT)!'$DATA(GMTYP)
QUIT
+7 SET ZTRTN="PQ^ORPRS13"
SET GMTI=0
+8 FOR
SET GMTI=$ORDER(ORSCPAT(GMTI))
if GMTI'>0
QUIT
SET ORVP=+ORSCPAT(GMTI)
DO HSOUT^GMTSDVR
+9 KILL ^XUTL("OR",$JOB,"ORU"),^("ORV"),^("ORW")
+10 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 IF $GET(DIC("B"))="GMTS HS ADHOC OPTION"
KILL DIC("B")
+6 KILL GMTYP
+7 DO ^DIC
+8 if +Y'>0
QUIT
+9 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
+10 SET GMTYP(0)=1
SET GMTYP(1)=Y_U_$PIECE(Y,U,2)_U_$PIECE(Y,U,2)_U_$PIECE(Y,U,2)
+11 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 TRFAC,VAERR,VAIN,VAROOT
+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 DFN=+ORVP
+10 DO EN^GMTS1
End DoDot:1
+11 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
+4 DO SELFILE
End DoDot:1
+5 SET GMTSEGC=GMTI
+6 QUIT
SELFILE ; Get Selection item information for GMTSEG(
+1 NEW GMTK,ITEM,FST
+2 SET GMTK=0
SET FST=1
+3 FOR
SET GMTK=$ORDER(^GMT(142,GMTSTYP,1,GMTJ,1,GMTK))
if GMTK'>0
QUIT
SET ITEM=^(GMTK,0)
SET GMTSEG(GMTI,+$PIECE(@(U_$PIECE(ITEM,";",2)_"0)"),U,2),GMTK)=$PIECE(ITEM,";")
IF $GET(FST)
SET GMTSEG(GMTI,+$PIECE(@(U_$PIECE(ITEM,";",2)_"0)"),U,2),0)=U_$PIECE(ITEM,";",2)
KILL FST
+4 QUIT
ADHOC ;Do adhoc
+1 SET GMTSTITL="AD HOC"
+2 SET DFN=+ORVP
+3 DO EN^GMTS1
+4 KILL GMTSEG,GMTSEGI
+5 QUIT
