| 1 | ORPRS13 ; slc/dcm,JER - Health Summary Report & Driver (HSR&D) ;6/10/97  15:52
 | 
|---|
| 2 |  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**11**;Dec 17, 1997
 | 
|---|
| 3 | MAIN ;Happy Birthday Elvis!!!
 | 
|---|
| 4 |  N C,I,GMTYP,VAROOT,ZTRTN,GMTI,ORVP
 | 
|---|
| 5 |  K ^XUTL("OR",$J,"ORU"),^("ORV"),^("ORW")
 | 
|---|
| 6 |  D:$D(ORSCPAT)'>9 P^ORPRS01
 | 
|---|
| 7 |  Q:$D(DUOUT)!$D(DIROUT)!'$D(ORSCPAT)
 | 
|---|
| 8 |  D SELTYP
 | 
|---|
| 9 |  Q:$D(DUOUT)!$D(DIROUT)!'$D(GMTYP)
 | 
|---|
| 10 |  S ZTRTN="PQ^ORPRS13",GMTI=0
 | 
|---|
| 11 |  F  S GMTI=$O(ORSCPAT(GMTI)) Q:GMTI'>0  S ORVP=+ORSCPAT(GMTI) D HSOUT^GMTSDVR
 | 
|---|
| 12 |  K ^XUTL("OR",$J,"ORU"),^("ORV"),^("ORW")
 | 
|---|
| 13 |  Q
 | 
|---|
| 14 | SELTYP ; Select Health Summary Type(s)
 | 
|---|
| 15 |  N DIC,X,Y
 | 
|---|
| 16 |  S DIC=142,DIC("A")="Select Health Summary Type: ",DIC(0)="AEMQZ"
 | 
|---|
| 17 |  S DIC("S")="I $P(^(0),U)'=""GMTS HS ADHOC OPTION"""
 | 
|---|
| 18 |  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))
 | 
|---|
| 19 |  I $G(DIC("B"))="GMTS HS ADHOC OPTION" K DIC("B")
 | 
|---|
| 20 |  K GMTYP
 | 
|---|
| 21 |  D ^DIC
 | 
|---|
| 22 |  Q:+Y'>0
 | 
|---|
| 23 |  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
 | 
|---|
| 24 |  S GMTYP(0)=1,GMTYP(1)=Y_U_$P(Y,U,2)_U_$P(Y,U,2)_U_$P(Y,U,2)
 | 
|---|
| 25 |  Q
 | 
|---|
| 26 | PQ ; Queued subroutine for HS by patient
 | 
|---|
| 27 |  N DFN,GMTI,GMTS,GMTS1,GMTS2,GMTSAGE,GMTSDOB,GMTSDTM,GMTSLO,GMTSLPG,GMTSPNM
 | 
|---|
| 28 |  N GMTSRB,GMTSSN,GMTSTOF,GMTSTYP,GMTSTITL,GMTSWARD,GMTJ,I,IX0,J,M4,P17,SEX
 | 
|---|
| 29 |  N TRFAC,VAERR,VAIN,VAROOT
 | 
|---|
| 30 |  S GMTI=0 F  S GMTI=$O(GMTYP(GMTI)) Q:GMTI'>0!$D(DIROUT)  D
 | 
|---|
| 31 |  . N GMTSEG,GMTSEGC,GMTSEGI
 | 
|---|
| 32 |  . S GMTSTYP=+$G(GMTYP(GMTI)),GMTSTITL=$G(^GMT(142,+GMTSTYP,"T"))
 | 
|---|
| 33 |  . S:'$L(GMTSTITL) GMTSTITL=$P(GMTYP(GMTI),U,2)
 | 
|---|
| 34 |  . D LOADSEG
 | 
|---|
| 35 |  . S DFN=+ORVP
 | 
|---|
| 36 |  . D EN^GMTS1
 | 
|---|
| 37 |  Q
 | 
|---|
| 38 | LOADSEG ;LOAD ENABLED COMPONENTS INTO GMTSEG ARRAY
 | 
|---|
| 39 |  N GMTI,GMTJ,GMX
 | 
|---|
| 40 |  S (GMTI,GMTJ)=0 F  S GMTJ=$O(^GMT(142,GMTSTYP,1,GMTJ)) Q:GMTJ'>0  S GMX=^(GMTJ,0) D
 | 
|---|
| 41 |  . S GMTI=GMTI+1,GMTSEG(GMTI)=GMX,GMTSEGI($P(GMX,U,2))=GMTI
 | 
|---|
| 42 |  . D SELFILE
 | 
|---|
| 43 |  S GMTSEGC=GMTI
 | 
|---|
| 44 |  Q
 | 
|---|
| 45 | SELFILE ; Get Selection item information for GMTSEG(
 | 
|---|
| 46 |  N GMTK,ITEM,FST
 | 
|---|
| 47 |  S GMTK=0,FST=1
 | 
|---|
| 48 |  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
 | 
|---|
| 49 |  Q
 | 
|---|
| 50 | ADHOC ;Do adhoc
 | 
|---|
| 51 |  S GMTSTITL="AD HOC"
 | 
|---|
| 52 |  S DFN=+ORVP
 | 
|---|
| 53 |  D EN^GMTS1
 | 
|---|
| 54 |  K GMTSEG,GMTSEGI
 | 
|---|
| 55 |  Q
 | 
|---|