source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORPRS13.m@ 949

Last change on this file since 949 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1ORPRS13 ; 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
3MAIN ;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
14SELTYP ; 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
26PQ ; 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
38LOADSEG ;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
45SELFILE ; 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
50ADHOC ;Do adhoc
51 S GMTSTITL="AD HOC"
52 S DFN=+ORVP
53 D EN^GMTS1
54 K GMTSEG,GMTSEGI
55 Q
Note: See TracBrowser for help on using the repository browser.