- 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
- 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
