| 1 | GMTS ; SLC/KER - Health Summary Main Routine ; 02/27/2002
|
|---|
| 2 | ;;2.7;Health Summary;**16,24,28,30,31,35,49**;Oct 20, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | ; External References
|
|---|
| 5 | ; DBIA 510 ^DISV(
|
|---|
| 6 | ; DBIA 10035 ^DPT(
|
|---|
| 7 | ; DBIA 10076 ^XUSEC("GMTS VIEW ONLY"
|
|---|
| 8 | ; DBIA 2160 ^XUTL("OR"
|
|---|
| 9 | ; DBIA 10086 ^%ZIS
|
|---|
| 10 | ; DBIA 10089 ^%ZISC
|
|---|
| 11 | ; DBIA 10063 ^%ZTLOAD
|
|---|
| 12 | ; DBIA 148 PATIENT^ORU1
|
|---|
| 13 | ; DBIA 10141 $$VERSION^XPDUTL
|
|---|
| 14 | ;
|
|---|
| 15 | MAIN ; Controls branching
|
|---|
| 16 | ;
|
|---|
| 17 | ; GMTSPXGO & GMRANGE are set in 2 calling
|
|---|
| 18 | ; options, They aren't meant to be used together.
|
|---|
| 19 | ;
|
|---|
| 20 | I +$G(GMTSPXGO)'>0,$L($T(PATIENT^ORU1)),($$VERSION^XPDUTL("OR")>2.19) D MAIN^GMTSDVR Q
|
|---|
| 21 | N DIROUT,DUOUT,ZTRTN,GMTSPX1,GMTSPX2,GMNAME,GMPSAP
|
|---|
| 22 | S GMTSTYP=0 K DIC,DIROUT,DUOUT
|
|---|
| 23 | S DIC("B")=$P($G(^GMT(142,+$G(^DISV(+$G(DUZ),"^GMT(142,")),0)),U)
|
|---|
| 24 | F Q:$D(DIROUT)!$D(DUOUT) D SELTYP Q:GMTSTYP'>0!$D(DIROUT)!$D(DUOUT) D
|
|---|
| 25 | . N GMPAT,DFN,GMTSMULT
|
|---|
| 26 | . F Q:$D(DIROUT) D Q:$D(DIROUT)!$D(DUOUT)!(+$D(GMPAT)'>0)!+$G(ORVP)
|
|---|
| 27 | . . K GMPAT,DFN
|
|---|
| 28 | . . I +$G(ORVP) D
|
|---|
| 29 | . . . S (DFN,GMPAT(1))=+ORVP,GMNAME=$P($G(^DPT(+DFN,0)),U) Q:GMNAME="" S GMPATT(GMNAME,DFN)="",(GMTSPX1,GMTSPX2)=""
|
|---|
| 30 | . . . W !!,"For patient ",GMNAME," please answer the following."
|
|---|
| 31 | . . . I +$G(GMTSPXGO)>0 D MENU^GMTSPXU2(DFN,.GMTSPX2,.GMTSPX1)
|
|---|
| 32 | . . . I $G(GMTSPX1)']""!($G(GMTSPX2)']"") S DIROUT=1 K GMPAT,GMPATT Q
|
|---|
| 33 | . . . Q:$D(DIROUT) S GMPAT(GMNAME_(9999999-GMTSPX1),+DFN)=+DFN_U_$G(GMTSPX1)_U_$G(GMTSPX2)
|
|---|
| 34 | . . I '(+($G(ORVP))) F Q:$D(DIROUT) K GMPATT D SELPT Q:$D(DIROUT)!('$D(GMPATT)) S GMNAME="" F S GMNAME=$O(GMPATT(GMNAME)) Q:GMNAME=""!$D(DIROUT) F DFN=0:0 S DFN=$O(GMPATT(GMNAME,DFN)) Q:DFN="" D Q:$D(DIROUT)
|
|---|
| 35 | . . . S (GMTSPX1,GMTSPX2)="" W !!,"For patient ",GMNAME," please answer the following."
|
|---|
| 36 | . . . I +$G(GMTSPXGO)>0 D MENU^GMTSPXU2(DFN,.GMTSPX2,.GMTSPX1) I $G(GMTSPX1)']""!($G(GMTSPX2)']"") Q
|
|---|
| 37 | . . . Q:$D(DIROUT)
|
|---|
| 38 | . . . S GMPAT(GMNAME_(9999999-GMTSPX1),+DFN)=+DFN_U_$G(GMTSPX1)_U_$G(GMTSPX2)
|
|---|
| 39 | . . Q:$D(DIROUT)!(+$D(GMPAT)'>0)
|
|---|
| 40 | . . I +$G(GMRANGE)>0 D GETRANGE^GMTSU(.GMTSPX1,.GMTSPX2) Q:$G(GMTSPX1)=""!($G(GMTSPX2)="")
|
|---|
| 41 | . . Q:$D(DIROUT)
|
|---|
| 42 | . . D RESUB^GMTSDVR(.GMPAT)
|
|---|
| 43 | . . S GMPSAP=$$RXAP^GMTSPD2 Q:$D(DIROUT)!$D(DTOUT)
|
|---|
| 44 | . . S ZTRTN="PQ^GMTS"
|
|---|
| 45 | . . D HSOUT^GMTSDVR,END W !
|
|---|
| 46 | K GMTSTYP,GMTSTITL,GMTSEG,GMTSEGI,GMTSEGC,GMX,DFN,X,Y,I,GMP,GMPATT
|
|---|
| 47 | Q
|
|---|
| 48 | SELTYP ; Select a Health Summary Type for printing
|
|---|
| 49 | Q:GMTSTYP=-1 S DIC=142,DIC("A")="Select Health Summary Type: ",DIC(0)="AEQM",DIC("S")="I $P(^(0),U)'=""GMTS HS ADHOC OPTION"""
|
|---|
| 50 | S Y=$$TYPE^GMTSULT K DIC S GMTSTYP=+Y,GMTSTITL=$S($D(^GMT(142,+Y,"T")):^("T"),1:"") S:GMTSTITL="" GMTSTITL=$P(Y,"^",2)
|
|---|
| 51 | I GMTSTYP>0,$S($D(^GMT(142,GMTSTYP,1,0))=0:1,$O(^(0))'>0:1,1:0) W !,"This Summary Type includes no components...Please choose another." G SELTYP
|
|---|
| 52 | SELTYP1 ; Get each component record
|
|---|
| 53 | K GMTSEG,GMTSEGI S (GMI,S1)=0 F S S1=$O(^GMT(142,GMTSTYP,1,S1)) Q:'S1 S GMX=^(S1,0) D LOADSEG
|
|---|
| 54 | S GMTSEGC=GMI K S1,S2,GMI
|
|---|
| 55 | Q
|
|---|
| 56 | LOADSEG ; Load enabled components into GMTSEG array
|
|---|
| 57 | S GMTS0=^GMT(142.1,$P(GMX,"^",2),0)
|
|---|
| 58 | S GMI=GMI+1,GMTSEG(GMI)=GMX,GMTSEGI($P(GMX,U,2))=GMI D SELFILE
|
|---|
| 59 | Q
|
|---|
| 60 | SELPT ; Select a patient
|
|---|
| 61 | N DUOUT,GMTSPRO,GMTSVER K ^XUTL("OR",$J,"ORU"),^("ORV"),^("ORW"),^("ORLP"),GMP
|
|---|
| 62 | S GMTSVER=+($$VERSION^XPDUTL("OR")),GMTSPRO=+($$PROK^GMTSU("ORU1",11))
|
|---|
| 63 | D:+GMTSVER>2.9&(GMTSPRO) PATIENT^ORU1(.GMP,,"I $P($G(^(""OOS"")),""^"")")
|
|---|
| 64 | D:+GMTSVER'>2.9!('GMTSPRO) PATIENT^ORU1(.GMP)
|
|---|
| 65 | D PATCOPY^GMTSDVR(.GMP,.GMPATT)
|
|---|
| 66 | Q
|
|---|
| 67 | SELFILE ; Load Selection Items in GMTSEG( array
|
|---|
| 68 | N SF,SR,S2 S S2=0 F S S2=$O(^GMT(142,GMTSTYP,1,S1,1,S2)) Q:'S2 D
|
|---|
| 69 | . S ENTRY=^(S2,0),SR=U_$P(ENTRY,";",2) Q:SR="^"
|
|---|
| 70 | . S SF=+$P(@(SR_"0)"),U,2) Q:+SF=0
|
|---|
| 71 | . S GMTSEG(GMI,SF,S2)=$P(ENTRY,";"),GMTSEG(GMI,SF,0)=SR
|
|---|
| 72 | Q
|
|---|
| 73 | PQ ; Queued subroutine for HS by patient
|
|---|
| 74 | N DFN,GMTS,GMTS1,GMTS2,GMTSAGE,GMTSDOB,GMTSDTM,GMTSLO,GMTSLPG,GMTSPNM
|
|---|
| 75 | N GMTSRB,GMTSSN,GMTSTOF,GMTSWARD,GMTJ,I,IX0,J,M4,P17,SEX
|
|---|
| 76 | N TRFAC,VAERR,VAIN
|
|---|
| 77 | S GMTJ=0 F S GMTJ=$O(GMPAT(GMTJ)) Q:GMTJ'>0!$D(DIROUT) D
|
|---|
| 78 | . S DFN=+$G(GMPAT(GMTJ))
|
|---|
| 79 | . I +$G(GMTSPXGO)>0 S GMTSPX1=$P($G(GMPAT(GMTJ)),U,2) D
|
|---|
| 80 | . . S GMTSPX2=$P($G(GMPAT(GMTJ)),U,3)
|
|---|
| 81 | . . I +GMTSPX1'>0!+GMTSPX2'>0 K GMTSPX1,GMTSPX2
|
|---|
| 82 | . N GMDUOUT
|
|---|
| 83 | . D EN^GMTS1
|
|---|
| 84 | . Q:$D(DIROUT)!+$G(GMDUOUT)
|
|---|
| 85 | . D ACTPROF^GMTSDVR(DFN)
|
|---|
| 86 | Q
|
|---|
| 87 | HSOUT ; Output Summary, with DEVICE handling
|
|---|
| 88 | K ZTSK
|
|---|
| 89 | I $D(^XUSEC("GMTS VIEW ONLY",DUZ)) D EN^GMTS1 Q
|
|---|
| 90 | K IOP S %ZIS="PQ" D ^%ZIS Q:POP
|
|---|
| 91 | G:$D(IO("Q")) QUE
|
|---|
| 92 | NOQUE ; Print non-queued output to selected device
|
|---|
| 93 | D EN^GMTS1
|
|---|
| 94 | D ^%ZISC
|
|---|
| 95 | Q
|
|---|
| 96 | QUE ; Call TaskMan to Queue output
|
|---|
| 97 | K IO("Q"),ZTSAVE F %="DFN","GMTS*","ENTRY" S ZTSAVE(%)=""
|
|---|
| 98 | S ZTRTN="EN^GMTS1",ZTDESC="HEALTH SUMMARY",ZTIO=ION
|
|---|
| 99 | D ^%ZTLOAD W !,$S($D(ZTSK):"Request Queued!",1:"Request Cancelled!")
|
|---|
| 100 | K ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE D ^%ZISC
|
|---|
| 101 | S IOP="HOME" D ^%ZIS
|
|---|
| 102 | Q
|
|---|
| 103 | END ; Clean up environmental variables and EXIT Health Summary
|
|---|
| 104 | K %T,DIC,GMTS,GMTSLO,GMTSPNM,GMTSRB,GMTSWARD,GMTSDOB,DIC,X,Y,VA,VAIN,VAINDT,VADM,VAEL,VAPA,VAERR,GMTSSN,GMTS0,GMTS1,GMTS2
|
|---|
| 105 | K GMTSAGE,GMTSTIM,GMTSEGN,GMTSEGH,GMTSEGL,GMTSHDR,GMTSNPG,GMTSPG,GMTSQIT,GMTSX,ENTRY,Z1,GMTSDTM,GMTSLOCK,GMTSLPG,SEX,POP,C,GMTSTOF
|
|---|
| 106 | Q
|
|---|
| 107 | ENCWA ; Entry point printing components
|
|---|
| 108 | ;
|
|---|
| 109 | ; GMTSPRM can be set to any component abbreviations
|
|---|
| 110 | ; except ones that require selection items. Needs
|
|---|
| 111 | ; to be valid component abbreviation from the "C"
|
|---|
| 112 | ; x-ref of File 142.1.
|
|---|
| 113 | ;
|
|---|
| 114 | ; Call with DFN, GMTSPRM="CD,CN,CW,ADR", GMTSTITL="TITLE"
|
|---|
| 115 | ;
|
|---|
| 116 | ; GMTSPX1=Optional FM date for ending date
|
|---|
| 117 | ; GMTSPX2=Optional FM date for beginning date
|
|---|
| 118 | ;
|
|---|
| 119 | ; NOTE: Optional date range variables are both
|
|---|
| 120 | ; required if a date range is desired.
|
|---|
| 121 | ;
|
|---|
| 122 | N GMI,GMJ,GMTSEG,GMTSEGI,GMTSEGC
|
|---|
| 123 | S GMTS1="9999999",GMTS2="6666666",GMI=0,GMTSPNF=1
|
|---|
| 124 | I '$D(GMTSPRM) W !,"The parameter GMTSPRM is undefined.",! Q
|
|---|
| 125 | I '$D(GMTSTITL) W !,"The parameter GMTSTITL is undefined.",! Q
|
|---|
| 126 | I '+$G(DFN) W !,"The parameter DFN is undefined.",! Q
|
|---|
| 127 | F GMJ=1:1:$L(GMTSPRM,",") S ABB=$P(GMTSPRM,",",GMJ) D LOAD Q:GMJ=-1
|
|---|
| 128 | S GMTSEGC=GMI K ABB,IFN
|
|---|
| 129 | D EN^GMTS1
|
|---|
| 130 | D END K GMTSEG,GMTSEGI,GMTSEGC,GMTSTITL,GMTSPRM,GMTSPNF
|
|---|
| 131 | Q
|
|---|
| 132 | LOAD ; Load GMTSEG() using GMTSPRM abbreviations
|
|---|
| 133 | S IFN=$O(^GMT(142.1,"C",ABB,"")) Q:IFN=""
|
|---|
| 134 | S GMI=GMI+1,GMTSEG(GMI)=GMI_"^"_IFN,GMTSEGI(IFN)=GMI
|
|---|
| 135 | Q
|
|---|
