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