| 1 | GMTSXAR ; SLC/KER - List Parameters/Resequence ; 02/27/2002
|
|---|
| 2 | ;;2.7;Health Summary;**49,62**;Oct 20, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | ; External References
|
|---|
| 5 | ; DBIA 10022 %XY^%RCR
|
|---|
| 6 | ; DBIA 10018 ^DIE (file #8989.51)
|
|---|
| 7 | ; DBIA 10006 ^DIC (file #8989.51, 8989.518)
|
|---|
| 8 | ; DBIA 10026 ^DIR
|
|---|
| 9 | ; DBIA 2056 $$GET1^DIQ (file #8989.513)
|
|---|
| 10 | ; DBIA 2052 FIELD^DID (file #8989.51)
|
|---|
| 11 | ; DBIA 2992 ^XTV(8989.51,
|
|---|
| 12 | ;
|
|---|
| 13 | Q
|
|---|
| 14 | EN ; Main Entry
|
|---|
| 15 | N X,%X,Y,%Y,DA,DIC,DIDEL,DIE,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,GMTSA,GMTSC,GMTSCHG,GMTSCNT,GMTSCONT,GMTSCT,GMTSCUR,GMTSD,GMTSEQ,GMTSEXIT
|
|---|
| 16 | N GMTSF,GMTSFI,GMTSI,GMTSIE,GMTSM,GMTSMAX,GMTSN,GMTSNEW,GMTSNXC,GMTSNXT,GMTSO,GMTSOK,GMTSOLD,GMTSON,GMTSORD,GMTSPARM,GMTSPI,GMTSREM
|
|---|
| 17 | N GMTSREO,GMTSSSO,GMTST,GMTSTOT,GMTSUSR,GMTSMGR
|
|---|
| 18 | S GMTSMGR=$$MGR^GMTSXAW3 Q:GMTSMGR'>0
|
|---|
| 19 | S GMTSCHG=0,GMTSPARM="ORWRP HEALTH SUMMARY TYPE LIST"
|
|---|
| 20 | S GMTSPI=$$PDI^GMTSXAW3(GMTSPARM) Q:+GMTSPI=0
|
|---|
| 21 | S %X="^XTV(8989.51,"_GMTSPI_",30,",%Y="GMTSO(""AL""," D %XY^%RCR S %X="^XTV(8989.518,",%Y="GMTSO(""ET""," D %XY^%RCR K GMTSO("ET","B"),GMTSO("ET","C")
|
|---|
| 22 | S (GMTSI,GMTSC)=0 F S GMTSI=$O(GMTSO("AL","B",GMTSI)) Q:+GMTSI=0 D
|
|---|
| 23 | . N GMTSIE S GMTSEQ(GMTSI)="",GMTSIE=0
|
|---|
| 24 | . F S GMTSIE=$O(GMTSO("AL","B",GMTSI,GMTSIE)) Q:+GMTSIE=0 D
|
|---|
| 25 | . . N GMTSF S GMTSF=$P($G(GMTSO("AL",GMTSIE,0)),"^",2) Q:+GMTSF=0 Q:'$D(GMTSO("ET",GMTSF,0))
|
|---|
| 26 | . . S GMTSC=GMTSC+1
|
|---|
| 27 | . . S (GMTSCUR(GMTSC),GMTSOLD(GMTSC))=GMTSI_"^"_GMTSF_"^"_$G(GMTSO("ET",GMTSF,0))
|
|---|
| 28 | . . S GMTSOLD("B",GMTSI,GMTSC)=""
|
|---|
| 29 | D ORD D:+($G(GMTSEXIT))=0 CHK
|
|---|
| 30 | W:+($G(GMTSCHG))'>0 !!,?2,"No Changes Made"
|
|---|
| 31 | Q
|
|---|
| 32 | ORD ; Order of Entities
|
|---|
| 33 | N GMTSI,GMTST,GMTSC,GMTSCNT,GMTSTOT,GMTSREM,GMTSSO,GMTSNXT,GMTSNXC,GMTSON
|
|---|
| 34 | S (GMTSSO,GMTSCNT,GMTSI,GMTSON)=0,(GMTSTOT,GMTST)=$$TOT Q:+GMTSTOT'>1
|
|---|
| 35 | S GMTSEXIT=0,GMTSCONT=$$CONT I +GMTSCONT>0 S GMTSEXIT=1 Q
|
|---|
| 36 | W !!," Please select the order in which you want these to be entities"
|
|---|
| 37 | W !," to be used." F Q:+($G(GMTSEXIT))>0 D SO Q:+($G(GMTSEXIT))>0 Q:'$D(GMTSOLD)
|
|---|
| 38 | S GMTSEXIT=0
|
|---|
| 39 | Q
|
|---|
| 40 | ;
|
|---|
| 41 | SO ; Select Order
|
|---|
| 42 | K GMTSOLD("B") N GMTSI,GMTSC,GMTSMAX,GMTSREO S GMTSI=0,GMTSREM=$$TOT
|
|---|
| 43 | S GMTSCNT=GMTSTOT-GMTSREM,GMTSNXT=GMTSCNT+1,GMTSSO=+($G(GMTSSO))+1
|
|---|
| 44 | S GMTSNXC=$S(GMTSNXT=1:(GMTSNXT_"st"),GMTSNXT=2:(GMTSNXT_"nd"),GMTSNXT=3:(GMTSNXT_"rd"),1:(GMTSNXT_"th"))
|
|---|
| 45 | I +GMTSREM=1 S Y=+GMTSREM D SET Q
|
|---|
| 46 | W ! D SOL,REO S (GMTSC,GMTSI)=0
|
|---|
| 47 | S GMTSMAX=GMTSREM W ! N DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y
|
|---|
| 48 | S DIR(0)="NAO^1:"_GMTSMAX_":0",DIR("?")="^D SOH1^GMTSXAR",DIR("??")="^D SOH2^GMTSXAR"
|
|---|
| 49 | S DIR("A")=" Select the "_GMTSNXC_" entity to be used: "
|
|---|
| 50 | K DIR("B") S:+($O(GMTSREO(0)))>0 DIR("B")=+($O(GMTSREO(0)))
|
|---|
| 51 | D ^DIR I Y="",X="@" D
|
|---|
| 52 | . N GMTSD S GMTSD=$P($G(^GMT(142.98,+($G(GMTSUSR)),1)),"^",2)
|
|---|
| 53 | . S GMTSEXIT="1^"_$S($L(GMTSD):"",1:"exiting")
|
|---|
| 54 | . S Y="@" K GMTSORD S GMTSORD("@")=""
|
|---|
| 55 | S:Y["^"!($D(DUOUT))!($D(DIROUT)) GMTSEXIT="1^exiting" S:$D(DTOUT) GMTSEXIT="1^try later"
|
|---|
| 56 | I +($G(GMTSEXIT))>0 W $S($L($P(GMTSEXIT,"^",2)):"...",1:""),$P(GMTSEXIT,"^",2) Q
|
|---|
| 57 | I +Y>0,+Y'>GMTSREM D SET
|
|---|
| 58 | Q
|
|---|
| 59 | SOL ; List
|
|---|
| 60 | N GMTSN,GMTSA,GMTST,GMTSC,GMTSI S (GMTSC,GMTSI)=0 F S GMTSI=$O(GMTSOLD(GMTSI)) Q:+GMTSI=0 D
|
|---|
| 61 | . S GMTSC=GMTSC+1,GMTSA=$P(GMTSOLD(GMTSI),"^",4),GMTSN=$P(GMTSOLD(GMTSI),"^",5)
|
|---|
| 62 | . S GMTST=GMTSN_$S(GMTSA="DEV"!(GMTSA="DIV")!(GMTSA="SYS")!(GMTSA="PKG")!(GMTSA="LOC")!(GMTSA="BED"):" level ",1:" ")_"defined Health Summary Types"
|
|---|
| 63 | . W !,?5,$J(GMTSC,4)," ",GMTST
|
|---|
| 64 | Q
|
|---|
| 65 | SOH1 ; Help - Single ?
|
|---|
| 66 | N GMTSC,GMTSI,GMTSN,GMTSCT S (GMTSC,GMTSI)=0,GMTSCT=+($G(GMTSNXT)) F S GMTSI=$O(GMTSOLD(GMTSI)) Q:+GMTSI=0 S GMTSC=GMTSC+1
|
|---|
| 67 | S GMTSN=$S(GMTSCT=1:"first",GMTSCT=2:"second",GMTSCT=3:"third",GMTSCT=4:"fourth",GMTSCT=5:"fifty",GMTSCT=6:"sixth",GMTSCT=7:"seventh",GMTSCT=8:"eighth",GMTSCT=9:"nineth",GMTSCT=10:"tenth",GMTSCT=11:"eleventh",1:"")
|
|---|
| 68 | I '$L(GMTSN),+GMTSC>1 W !,?11,"Select a Health Summary Type entity to list" W:$L($G(GMTSNXC)) " ",GMTSNXC W " (1-",GMTSC,")",!
|
|---|
| 69 | I $L(GMTSN),+GMTSC>1 W !,?11,"Select a Health Summary Type entity to list ",GMTSN," (1-",GMTSC,")",!
|
|---|
| 70 | D SOL
|
|---|
| 71 | Q
|
|---|
| 72 | SOH2 ; Help - Double ??
|
|---|
| 73 | I '$L($G(GMTSPARM)) D SOH1 Q
|
|---|
| 74 | W !,?11,"Parameter """,GMTSPARM,""" has multiple "
|
|---|
| 75 | W !,?11,"allowable entities for which Health Summary Types may"
|
|---|
| 76 | W !,?11,"be assigned and displayed on the CPRS reports tab. Now"
|
|---|
| 77 | W !,?11,"you must select the order in which you want these entites"
|
|---|
| 78 | W !,?11,"to be used by the site.",!
|
|---|
| 79 | D SOL
|
|---|
| 80 | Q
|
|---|
| 81 | ;
|
|---|
| 82 | ; Arrange
|
|---|
| 83 | SET ; Set Order
|
|---|
| 84 | D REO N GMTSO S GMTSO=+($O(GMTSORD(" "),-1))+1
|
|---|
| 85 | I $L($P($G(GMTSREO(+($G(Y)))),"^",2,299)) D
|
|---|
| 86 | . S GMTSON=$O(GMTSEQ(GMTSON))
|
|---|
| 87 | . S GMTSORD(GMTSO)=GMTSON_"^"_$P($G(GMTSREO(+Y)),"^",2,299)
|
|---|
| 88 | S (GMTSC,GMTSI)=0
|
|---|
| 89 | F S GMTSI=$O(GMTSOLD(GMTSI)) Q:+GMTSI=0 D
|
|---|
| 90 | . S GMTSC=GMTSC+1 I GMTSC=+Y K GMTSOLD(GMTSI),GMTSREO(GMTSC)
|
|---|
| 91 | Q
|
|---|
| 92 | REO ; Re-order
|
|---|
| 93 | K GMTSREO N GMTSC,GMTSI S (GMTSC,GMTSI)=0
|
|---|
| 94 | F S GMTSI=$O(GMTSOLD(GMTSI)) Q:+GMTSI=0 D
|
|---|
| 95 | . S GMTSC=GMTSC+1 S GMTSREO(GMTSC)=$G(GMTSOLD(GMTSI))
|
|---|
| 96 | Q
|
|---|
| 97 | TOT(X) ; Total Allowable Entities
|
|---|
| 98 | N GMTSI S (X,GMTSI)=0 F S GMTSI=$O(GMTSOLD(GMTSI)) Q:+GMTSI=0 S X=X+1
|
|---|
| 99 | Q X
|
|---|
| 100 | CONT(X) ; Ask to Continue
|
|---|
| 101 | S:$O(GMTSCUR(0))=0!('$L($G(GMTSPARM)))!(+($G(GMTSTOT))'>1) GMTSEXIT=1
|
|---|
| 102 | Q:$O(GMTSCUR(0))=0!('$L($G(GMTSPARM)))!(+($G(GMTSTOT))'>1) 0
|
|---|
| 103 | W !!!," Parameter """,GMTSPARM,""" has ",GMTSTOT," allowable entities"
|
|---|
| 104 | W !," which may have the Health Summary Types on the CPRS reports tab "
|
|---|
| 105 | W !," and are used in the following order:"
|
|---|
| 106 | N DIR,DIROUT,DUOUT,DTOUT,GMTSA,GMTSN,GMTST,GMTSC,GMTSI D CONTM
|
|---|
| 107 | S DIR("A")=" Are these in the correct order for your site? "
|
|---|
| 108 | S (DIR("?"),DIR("??"))="^D CONTH^GMTSXAR",DIR("B")="Y",DIR(0)="YAO" W ! D ^DIR
|
|---|
| 109 | S X=+($G(Y)) Q X
|
|---|
| 110 | Q 1
|
|---|
| 111 | CONTH ; Continue Help
|
|---|
| 112 | W !," Enter either 'Y' or 'N'"
|
|---|
| 113 | D CONTM Q
|
|---|
| 114 | CONTM ; Continue Menu
|
|---|
| 115 | S (GMTSC,GMTSI)=0 F S GMTSI=$O(GMTSCUR(GMTSI)) Q:+GMTSI=0 D
|
|---|
| 116 | . S GMTSA=$P(GMTSCUR(GMTSI),"^",4),GMTSN=$P(GMTSCUR(GMTSI),"^",5)
|
|---|
| 117 | . S GMTST=GMTSN_$S(GMTSA="DEV"!(GMTSA="DIV")!(GMTSA="SYS")!(GMTSA="PKG")!(GMTSA="LOC")!(GMTSA="BED"):" level ",1:" ")_"defined Health Summary Types"
|
|---|
| 118 | . S GMTSC=GMTSC+1 W:GMTSC=1 ! W !,$J(GMTSC,6)," ",GMTST
|
|---|
| 119 | Q
|
|---|
| 120 | CHK ; Check if OK
|
|---|
| 121 | N GMTSC,GMTSI,GMTSA S (GMTSC,GMTSI)=0 F S GMTSI=$O(GMTSCUR(GMTSI)) Q:+GMTSI=0 S:GMTSCUR(GMTSI)'[$G(GMTSORD(GMTSI)) GMTSC=1
|
|---|
| 122 | I 'GMTSC S GMTSCHG=0 Q
|
|---|
| 123 | W !!,?8,"You have selected to resequenced the Health Summary Type"
|
|---|
| 124 | W !,?8,"entities in the following order:",!
|
|---|
| 125 | D CHKM S GMTSA=$$OK D:+($G(GMTSA))>0 ED
|
|---|
| 126 | Q
|
|---|
| 127 | CHKM ; Check (Menu)
|
|---|
| 128 | N GMTSC,GMTSI S (GMTSC,GMTSI)=0 F S GMTSI=$O(GMTSCUR(GMTSI)) Q:+GMTSI=0 S:GMTSCUR(GMTSI)'[$G(GMTSORD(GMTSI)) GMTSC=1
|
|---|
| 129 | Q:'GMTSC S (GMTSC,GMTSI)=0 F S GMTSI=$O(GMTSCUR(GMTSI)) Q:+GMTSI=0 D
|
|---|
| 130 | . S GMTSC=GMTSC+1 W:GMTSC=1 !,?13,"FROM (Current)",?33,"TO (Resequenced)",!,?13,"----------------",?33,"----------------"
|
|---|
| 131 | . W !,?7,$J(GMTSC,4),?13,$P($G(GMTSCUR(GMTSI)),"^",5),?33,$P($G(GMTSORD(GMTSI)),"^",5)
|
|---|
| 132 | Q
|
|---|
| 133 | OK(X) ; Ask if OK
|
|---|
| 134 | W ! N DIR,DIROUT,DUOUT,DTOUT S (DIR("?"),DIR("??"))="^D OKH^GMTSXAR"
|
|---|
| 135 | S DIR("A")=" Is this OK? ",DIR("B")="Y",DIR(0)="YAO" D ^DIR S X=+($G(Y)) Q X
|
|---|
| 136 | OKH ; OK Help
|
|---|
| 137 | W !," Enter either 'Y' or 'N'",!,!," Resequence entities:",! D CHKM Q
|
|---|
| 138 | ;
|
|---|
| 139 | ED ; Edit Record
|
|---|
| 140 | N DIC,DA,DIE,DR,DIDEL,DTOUT,GMTSFI,GMTSI,GMTSEQ,GMTSCNT,GMTST
|
|---|
| 141 | S GMTSPI=+($G(GMTSPI)),GMTSCNT=0
|
|---|
| 142 | I GMTSPI'>0!(+($O(GMTSORD(0)))'>0)!('$L($G(GMTSPARM)))!($$PDN^GMTSXAW3(+GMTSPI)'=$G(GMTSPARM)) D Q
|
|---|
| 143 | . W !,?5," Unable to resequence at this time."
|
|---|
| 144 | S DA(1)=+($G(GMTSPI)) Q:DA(1)'>0 S (DIC,DIE)="^XTV(8989.51,"_DA(1)_",30,",DR=".02///^S X=$G(GMTSFI)"
|
|---|
| 145 | L ; Lock Record
|
|---|
| 146 | L +^XTV(8989.51,+($G(GMTSPI))) S GMTSCNT=GMTSCNT+1,GMTST=$T
|
|---|
| 147 | I 'GMTST,GMTSCNT'>3 H 2 G L
|
|---|
| 148 | I 'GMTST,GMTSCNT>3 W !," Another user is editing this entry.",!," Unable to resequence at this time." Q
|
|---|
| 149 | S GMTSI=0 F S GMTSI=$O(GMTSORD(GMTSI)) Q:+GMTSI=0 D
|
|---|
| 150 | . S GMTSFI=$P(GMTSORD(GMTSI),"^",2),GMTSEQ=$P(GMTSORD(GMTSI),"^",1)
|
|---|
| 151 | . S DA=$$DA(DA(1),GMTSEQ),X=GMTSEQ D ^DIE S GMTSCHG=1
|
|---|
| 152 | L -^XTV(8989.51,+($G(GMTSPI)))
|
|---|
| 153 | Q
|
|---|
| 154 | DA(GMTSI,X) ; Get DA
|
|---|
| 155 | N DA,DIC,DTOUT,DUOUT,Y,GMTSM S DA(1)=+($G(GMTSI)),X=+($G(X))
|
|---|
| 156 | S DIC="^XTV(8989.51,"_DA(1)_",30,",DIC(0)="M" D ^DIC S X=+($G(Y)) Q X
|
|---|
| 157 | Q
|
|---|
| 158 | ;
|
|---|
| 159 | ADED ; Add/Edit
|
|---|
| 160 | N X,Y,DA,DIC,DIE,DLAYGO,DR,DTOUT,DUOUT,GMTSCNT,GMTSDEF,GMTSENT
|
|---|
| 161 | N GMTSM,GMTSMGR,GMTSNEW,GMTSPARM,GMTSPI,GMTST
|
|---|
| 162 | S GMTSMGR=$$MGR^GMTSXAW3 Q:GMTSMGR'>0
|
|---|
| 163 | S GMTSPARM="ORWRP HEALTH SUMMARY TYPE LIST"
|
|---|
| 164 | S GMTSPI=$$PDI^GMTSXAW3(GMTSPARM) Q:+GMTSPI=0
|
|---|
| 165 | W !! W:$L(GMTSPARM) "'" W GMTSPARM W:$L(GMTSPARM) "' " W "ALLOWABLE ENTITIES",!
|
|---|
| 166 | S DA(1)=+($G(GMTSPI)),GMTSCNT=0
|
|---|
| 167 | S (DIC,DIE)="^XTV(8989.51,"_DA(1)_",30,",DIC(0)="AEQMLZ"
|
|---|
| 168 | S DIC("DR")=".02///^S X=$$AE^GMTSXAR(+($G(Y)))"
|
|---|
| 169 | S DLAYGO="" D FIELD^DID(8989.51,30,"","SPECIFIER","GMTST(""DID"")","GMTSM(""ERR"")")
|
|---|
| 170 | S:$L($G(GMTST("DID","SPECIFIER"))) DIC("P")=$G(GMTST("DID","SPECIFIER"))
|
|---|
| 171 | L2 ; Lock Record
|
|---|
| 172 | L +^XTV(8989.51,+($G(GMTSPI))) S GMTSCNT=GMTSCNT+1,GMTST=$T
|
|---|
| 173 | I 'GMTST,GMTSCNT'>3 H 2 G L2
|
|---|
| 174 | I 'GMTST,GMTSCNT>3 W !," Another user is editing this entry.",!," Unable to resequence at this time." Q
|
|---|
| 175 | D ^DIC S GMTSNEW=+($P($G(Y),"^",3)) Q:GMTSNEW>0 Q:+Y'>0
|
|---|
| 176 | N DIC,DIE S DA(1)=GMTSPI,DA=+($G(Y)),(DIC,DIE)="^XTV(8989.51,"_DA(1)_",30,"
|
|---|
| 177 | S DA=+($G(Y)),DR=".01;.02///^S X=$$AE^GMTSXAR("_DA_")"
|
|---|
| 178 | D ^DIE L -^XTV(8989.51,+($G(GMTSPI)))
|
|---|
| 179 | Q
|
|---|
| 180 | AE(X) ; Allowable Entity
|
|---|
| 181 | N DA,DIC,DTOUT,DUOUT,Y,GMTSPARM,GMTSPI,GMTSENT,GMTSDEF
|
|---|
| 182 | S GMTSDEF="",GMTSENT=+($G(X)),GMTSPARM="ORWRP HEALTH SUMMARY TYPE LIST"
|
|---|
| 183 | S GMTSPI=$$PDI^GMTSXAW3(GMTSPARM) Q:+GMTSPI=0 ""
|
|---|
| 184 | S:+GMTSENT>0 GMTSDEF=$$GET1^DIQ(8989.513,(GMTSENT_","_GMTSPI_","),.02)
|
|---|
| 185 | N DA,DIC,DTOUT,DUOUT,Y S DIC="^XTV(8989.518,",DIC(0)="AEMQ"
|
|---|
| 186 | S DIC("S")="I Y'=3.5&(Y'=9.4)&(Y'=44)&(Y'=404.51)&(Y'=405.4)"
|
|---|
| 187 | S:$L($G(GMTSDEF)) DIC("B")=GMTSDEF D ^DIC S X=+($G(Y))
|
|---|
| 188 | Q X
|
|---|
