- GMTSXAR ; SLC/KER - List Parameters/Resequence ; 02/27/2002
- ;;2.7;Health Summary;**49,62**;Oct 20, 1995
- ;
- ; External References
- ; DBIA 10022 %XY^%RCR
- ; DBIA 10018 ^DIE (file #8989.51)
- ; DBIA 10006 ^DIC (file #8989.51, 8989.518)
- ; DBIA 10026 ^DIR
- ; DBIA 2056 $$GET1^DIQ (file #8989.513)
- ; DBIA 2052 FIELD^DID (file #8989.51)
- ; DBIA 2992 ^XTV(8989.51,
- ;
- Q
- EN ; Main Entry
- 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
- N GMTSF,GMTSFI,GMTSI,GMTSIE,GMTSM,GMTSMAX,GMTSN,GMTSNEW,GMTSNXC,GMTSNXT,GMTSO,GMTSOK,GMTSOLD,GMTSON,GMTSORD,GMTSPARM,GMTSPI,GMTSREM
- N GMTSREO,GMTSSSO,GMTST,GMTSTOT,GMTSUSR,GMTSMGR
- S GMTSMGR=$$MGR^GMTSXAW3 Q:GMTSMGR'>0
- S GMTSCHG=0,GMTSPARM="ORWRP HEALTH SUMMARY TYPE LIST"
- S GMTSPI=$$PDI^GMTSXAW3(GMTSPARM) Q:+GMTSPI=0
- 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")
- S (GMTSI,GMTSC)=0 F S GMTSI=$O(GMTSO("AL","B",GMTSI)) Q:+GMTSI=0 D
- . N GMTSIE S GMTSEQ(GMTSI)="",GMTSIE=0
- . F S GMTSIE=$O(GMTSO("AL","B",GMTSI,GMTSIE)) Q:+GMTSIE=0 D
- . . N GMTSF S GMTSF=$P($G(GMTSO("AL",GMTSIE,0)),"^",2) Q:+GMTSF=0 Q:'$D(GMTSO("ET",GMTSF,0))
- . . S GMTSC=GMTSC+1
- . . S (GMTSCUR(GMTSC),GMTSOLD(GMTSC))=GMTSI_"^"_GMTSF_"^"_$G(GMTSO("ET",GMTSF,0))
- . . S GMTSOLD("B",GMTSI,GMTSC)=""
- D ORD D:+($G(GMTSEXIT))=0 CHK
- W:+($G(GMTSCHG))'>0 !!,?2,"No Changes Made"
- Q
- ORD ; Order of Entities
- N GMTSI,GMTST,GMTSC,GMTSCNT,GMTSTOT,GMTSREM,GMTSSO,GMTSNXT,GMTSNXC,GMTSON
- S (GMTSSO,GMTSCNT,GMTSI,GMTSON)=0,(GMTSTOT,GMTST)=$$TOT Q:+GMTSTOT'>1
- S GMTSEXIT=0,GMTSCONT=$$CONT I +GMTSCONT>0 S GMTSEXIT=1 Q
- W !!," Please select the order in which you want these to be entities"
- W !," to be used." F Q:+($G(GMTSEXIT))>0 D SO Q:+($G(GMTSEXIT))>0 Q:'$D(GMTSOLD)
- S GMTSEXIT=0
- Q
- ;
- SO ; Select Order
- K GMTSOLD("B") N GMTSI,GMTSC,GMTSMAX,GMTSREO S GMTSI=0,GMTSREM=$$TOT
- S GMTSCNT=GMTSTOT-GMTSREM,GMTSNXT=GMTSCNT+1,GMTSSO=+($G(GMTSSO))+1
- S GMTSNXC=$S(GMTSNXT=1:(GMTSNXT_"st"),GMTSNXT=2:(GMTSNXT_"nd"),GMTSNXT=3:(GMTSNXT_"rd"),1:(GMTSNXT_"th"))
- I +GMTSREM=1 S Y=+GMTSREM D SET Q
- W ! D SOL,REO S (GMTSC,GMTSI)=0
- S GMTSMAX=GMTSREM W ! N DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y
- S DIR(0)="NAO^1:"_GMTSMAX_":0",DIR("?")="^D SOH1^GMTSXAR",DIR("??")="^D SOH2^GMTSXAR"
- S DIR("A")=" Select the "_GMTSNXC_" entity to be used: "
- K DIR("B") S:+($O(GMTSREO(0)))>0 DIR("B")=+($O(GMTSREO(0)))
- D ^DIR I Y="",X="@" D
- . N GMTSD S GMTSD=$P($G(^GMT(142.98,+($G(GMTSUSR)),1)),"^",2)
- . S GMTSEXIT="1^"_$S($L(GMTSD):"",1:"exiting")
- . S Y="@" K GMTSORD S GMTSORD("@")=""
- S:Y["^"!($D(DUOUT))!($D(DIROUT)) GMTSEXIT="1^exiting" S:$D(DTOUT) GMTSEXIT="1^try later"
- I +($G(GMTSEXIT))>0 W $S($L($P(GMTSEXIT,"^",2)):"...",1:""),$P(GMTSEXIT,"^",2) Q
- I +Y>0,+Y'>GMTSREM D SET
- Q
- SOL ; List
- N GMTSN,GMTSA,GMTST,GMTSC,GMTSI S (GMTSC,GMTSI)=0 F S GMTSI=$O(GMTSOLD(GMTSI)) Q:+GMTSI=0 D
- . S GMTSC=GMTSC+1,GMTSA=$P(GMTSOLD(GMTSI),"^",4),GMTSN=$P(GMTSOLD(GMTSI),"^",5)
- . S GMTST=GMTSN_$S(GMTSA="DEV"!(GMTSA="DIV")!(GMTSA="SYS")!(GMTSA="PKG")!(GMTSA="LOC")!(GMTSA="BED"):" level ",1:" ")_"defined Health Summary Types"
- . W !,?5,$J(GMTSC,4)," ",GMTST
- Q
- SOH1 ; Help - Single ?
- 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
- 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:"")
- I '$L(GMTSN),+GMTSC>1 W !,?11,"Select a Health Summary Type entity to list" W:$L($G(GMTSNXC)) " ",GMTSNXC W " (1-",GMTSC,")",!
- I $L(GMTSN),+GMTSC>1 W !,?11,"Select a Health Summary Type entity to list ",GMTSN," (1-",GMTSC,")",!
- D SOL
- Q
- SOH2 ; Help - Double ??
- I '$L($G(GMTSPARM)) D SOH1 Q
- W !,?11,"Parameter """,GMTSPARM,""" has multiple "
- W !,?11,"allowable entities for which Health Summary Types may"
- W !,?11,"be assigned and displayed on the CPRS reports tab. Now"
- W !,?11,"you must select the order in which you want these entites"
- W !,?11,"to be used by the site.",!
- D SOL
- Q
- ;
- ; Arrange
- SET ; Set Order
- D REO N GMTSO S GMTSO=+($O(GMTSORD(" "),-1))+1
- I $L($P($G(GMTSREO(+($G(Y)))),"^",2,299)) D
- . S GMTSON=$O(GMTSEQ(GMTSON))
- . S GMTSORD(GMTSO)=GMTSON_"^"_$P($G(GMTSREO(+Y)),"^",2,299)
- S (GMTSC,GMTSI)=0
- F S GMTSI=$O(GMTSOLD(GMTSI)) Q:+GMTSI=0 D
- . S GMTSC=GMTSC+1 I GMTSC=+Y K GMTSOLD(GMTSI),GMTSREO(GMTSC)
- Q
- REO ; Re-order
- K GMTSREO N GMTSC,GMTSI S (GMTSC,GMTSI)=0
- F S GMTSI=$O(GMTSOLD(GMTSI)) Q:+GMTSI=0 D
- . S GMTSC=GMTSC+1 S GMTSREO(GMTSC)=$G(GMTSOLD(GMTSI))
- Q
- TOT(X) ; Total Allowable Entities
- N GMTSI S (X,GMTSI)=0 F S GMTSI=$O(GMTSOLD(GMTSI)) Q:+GMTSI=0 S X=X+1
- Q X
- CONT(X) ; Ask to Continue
- S:$O(GMTSCUR(0))=0!('$L($G(GMTSPARM)))!(+($G(GMTSTOT))'>1) GMTSEXIT=1
- Q:$O(GMTSCUR(0))=0!('$L($G(GMTSPARM)))!(+($G(GMTSTOT))'>1) 0
- W !!!," Parameter """,GMTSPARM,""" has ",GMTSTOT," allowable entities"
- W !," which may have the Health Summary Types on the CPRS reports tab "
- W !," and are used in the following order:"
- N DIR,DIROUT,DUOUT,DTOUT,GMTSA,GMTSN,GMTST,GMTSC,GMTSI D CONTM
- S DIR("A")=" Are these in the correct order for your site? "
- S (DIR("?"),DIR("??"))="^D CONTH^GMTSXAR",DIR("B")="Y",DIR(0)="YAO" W ! D ^DIR
- S X=+($G(Y)) Q X
- Q 1
- CONTH ; Continue Help
- W !," Enter either 'Y' or 'N'"
- D CONTM Q
- CONTM ; Continue Menu
- S (GMTSC,GMTSI)=0 F S GMTSI=$O(GMTSCUR(GMTSI)) Q:+GMTSI=0 D
- . S GMTSA=$P(GMTSCUR(GMTSI),"^",4),GMTSN=$P(GMTSCUR(GMTSI),"^",5)
- . S GMTST=GMTSN_$S(GMTSA="DEV"!(GMTSA="DIV")!(GMTSA="SYS")!(GMTSA="PKG")!(GMTSA="LOC")!(GMTSA="BED"):" level ",1:" ")_"defined Health Summary Types"
- . S GMTSC=GMTSC+1 W:GMTSC=1 ! W !,$J(GMTSC,6)," ",GMTST
- Q
- CHK ; Check if OK
- 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
- I 'GMTSC S GMTSCHG=0 Q
- W !!,?8,"You have selected to resequenced the Health Summary Type"
- W !,?8,"entities in the following order:",!
- D CHKM S GMTSA=$$OK D:+($G(GMTSA))>0 ED
- Q
- CHKM ; Check (Menu)
- N GMTSC,GMTSI S (GMTSC,GMTSI)=0 F S GMTSI=$O(GMTSCUR(GMTSI)) Q:+GMTSI=0 S:GMTSCUR(GMTSI)'[$G(GMTSORD(GMTSI)) GMTSC=1
- Q:'GMTSC S (GMTSC,GMTSI)=0 F S GMTSI=$O(GMTSCUR(GMTSI)) Q:+GMTSI=0 D
- . S GMTSC=GMTSC+1 W:GMTSC=1 !,?13,"FROM (Current)",?33,"TO (Resequenced)",!,?13,"----------------",?33,"----------------"
- . W !,?7,$J(GMTSC,4),?13,$P($G(GMTSCUR(GMTSI)),"^",5),?33,$P($G(GMTSORD(GMTSI)),"^",5)
- Q
- OK(X) ; Ask if OK
- W ! N DIR,DIROUT,DUOUT,DTOUT S (DIR("?"),DIR("??"))="^D OKH^GMTSXAR"
- S DIR("A")=" Is this OK? ",DIR("B")="Y",DIR(0)="YAO" D ^DIR S X=+($G(Y)) Q X
- OKH ; OK Help
- W !," Enter either 'Y' or 'N'",!,!," Resequence entities:",! D CHKM Q
- ;
- ED ; Edit Record
- N DIC,DA,DIE,DR,DIDEL,DTOUT,GMTSFI,GMTSI,GMTSEQ,GMTSCNT,GMTST
- S GMTSPI=+($G(GMTSPI)),GMTSCNT=0
- I GMTSPI'>0!(+($O(GMTSORD(0)))'>0)!('$L($G(GMTSPARM)))!($$PDN^GMTSXAW3(+GMTSPI)'=$G(GMTSPARM)) D Q
- . W !,?5," Unable to resequence at this time."
- S DA(1)=+($G(GMTSPI)) Q:DA(1)'>0 S (DIC,DIE)="^XTV(8989.51,"_DA(1)_",30,",DR=".02///^S X=$G(GMTSFI)"
- L ; Lock Record
- L +^XTV(8989.51,+($G(GMTSPI))) S GMTSCNT=GMTSCNT+1,GMTST=$T
- I 'GMTST,GMTSCNT'>3 H 2 G L
- I 'GMTST,GMTSCNT>3 W !," Another user is editing this entry.",!," Unable to resequence at this time." Q
- S GMTSI=0 F S GMTSI=$O(GMTSORD(GMTSI)) Q:+GMTSI=0 D
- . S GMTSFI=$P(GMTSORD(GMTSI),"^",2),GMTSEQ=$P(GMTSORD(GMTSI),"^",1)
- . S DA=$$DA(DA(1),GMTSEQ),X=GMTSEQ D ^DIE S GMTSCHG=1
- L -^XTV(8989.51,+($G(GMTSPI)))
- Q
- DA(GMTSI,X) ; Get DA
- N DA,DIC,DTOUT,DUOUT,Y,GMTSM S DA(1)=+($G(GMTSI)),X=+($G(X))
- S DIC="^XTV(8989.51,"_DA(1)_",30,",DIC(0)="M" D ^DIC S X=+($G(Y)) Q X
- Q
- ;
- ADED ; Add/Edit
- N X,Y,DA,DIC,DIE,DLAYGO,DR,DTOUT,DUOUT,GMTSCNT,GMTSDEF,GMTSENT
- N GMTSM,GMTSMGR,GMTSNEW,GMTSPARM,GMTSPI,GMTST
- S GMTSMGR=$$MGR^GMTSXAW3 Q:GMTSMGR'>0
- S GMTSPARM="ORWRP HEALTH SUMMARY TYPE LIST"
- S GMTSPI=$$PDI^GMTSXAW3(GMTSPARM) Q:+GMTSPI=0
- W !! W:$L(GMTSPARM) "'" W GMTSPARM W:$L(GMTSPARM) "' " W "ALLOWABLE ENTITIES",!
- S DA(1)=+($G(GMTSPI)),GMTSCNT=0
- S (DIC,DIE)="^XTV(8989.51,"_DA(1)_",30,",DIC(0)="AEQMLZ"
- S DIC("DR")=".02///^S X=$$AE^GMTSXAR(+($G(Y)))"
- S DLAYGO="" D FIELD^DID(8989.51,30,"","SPECIFIER","GMTST(""DID"")","GMTSM(""ERR"")")
- S:$L($G(GMTST("DID","SPECIFIER"))) DIC("P")=$G(GMTST("DID","SPECIFIER"))
- L2 ; Lock Record
- L +^XTV(8989.51,+($G(GMTSPI))) S GMTSCNT=GMTSCNT+1,GMTST=$T
- I 'GMTST,GMTSCNT'>3 H 2 G L2
- I 'GMTST,GMTSCNT>3 W !," Another user is editing this entry.",!," Unable to resequence at this time." Q
- D ^DIC S GMTSNEW=+($P($G(Y),"^",3)) Q:GMTSNEW>0 Q:+Y'>0
- N DIC,DIE S DA(1)=GMTSPI,DA=+($G(Y)),(DIC,DIE)="^XTV(8989.51,"_DA(1)_",30,"
- S DA=+($G(Y)),DR=".01;.02///^S X=$$AE^GMTSXAR("_DA_")"
- D ^DIE L -^XTV(8989.51,+($G(GMTSPI)))
- Q
- AE(X) ; Allowable Entity
- N DA,DIC,DTOUT,DUOUT,Y,GMTSPARM,GMTSPI,GMTSENT,GMTSDEF
- S GMTSDEF="",GMTSENT=+($G(X)),GMTSPARM="ORWRP HEALTH SUMMARY TYPE LIST"
- S GMTSPI=$$PDI^GMTSXAW3(GMTSPARM) Q:+GMTSPI=0 ""
- S:+GMTSENT>0 GMTSDEF=$$GET1^DIQ(8989.513,(GMTSENT_","_GMTSPI_","),.02)
- N DA,DIC,DTOUT,DUOUT,Y S DIC="^XTV(8989.518,",DIC(0)="AEMQ"
- S DIC("S")="I Y'=3.5&(Y'=9.4)&(Y'=44)&(Y'=404.51)&(Y'=405.4)"
- S:$L($G(GMTSDEF)) DIC("B")=GMTSDEF D ^DIC S X=+($G(Y))
- Q X
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSXAR 9682 printed Feb 18, 2025@23:27:13 Page 2
- GMTSXAR ; SLC/KER - List Parameters/Resequence ; 02/27/2002
- +1 ;;2.7;Health Summary;**49,62**;Oct 20, 1995
- +2 ;
- +3 ; External References
- +4 ; DBIA 10022 %XY^%RCR
- +5 ; DBIA 10018 ^DIE (file #8989.51)
- +6 ; DBIA 10006 ^DIC (file #8989.51, 8989.518)
- +7 ; DBIA 10026 ^DIR
- +8 ; DBIA 2056 $$GET1^DIQ (file #8989.513)
- +9 ; DBIA 2052 FIELD^DID (file #8989.51)
- +10 ; DBIA 2992 ^XTV(8989.51,
- +11 ;
- +12 QUIT
- EN ; Main Entry
- +1 NEW X,%X,Y,%Y,DA,DIC,DIDEL,DIE,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,GMTSA,GMTSC,GMTSCHG,GMTSCNT,GMTSCONT,GMTSCT,GMTSCUR,GMTSD,GMTSEQ,GMTSEXIT
- +2 NEW GMTSF,GMTSFI,GMTSI,GMTSIE,GMTSM,GMTSMAX,GMTSN,GMTSNEW,GMTSNXC,GMTSNXT,GMTSO,GMTSOK,GMTSOLD,GMTSON,GMTSORD,GMTSPARM,GMTSPI,GMTSREM
- +3 NEW GMTSREO,GMTSSSO,GMTST,GMTSTOT,GMTSUSR,GMTSMGR
- +4 SET GMTSMGR=$$MGR^GMTSXAW3
- if GMTSMGR'>0
- QUIT
- +5 SET GMTSCHG=0
- SET GMTSPARM="ORWRP HEALTH SUMMARY TYPE LIST"
- +6 SET GMTSPI=$$PDI^GMTSXAW3(GMTSPARM)
- if +GMTSPI=0
- QUIT
- +7 SET %X="^XTV(8989.51,"_GMTSPI_",30,"
- SET %Y="GMTSO(""AL"","
- DO %XY^%RCR
- SET %X="^XTV(8989.518,"
- SET %Y="GMTSO(""ET"","
- DO %XY^%RCR
- KILL GMTSO("ET","B"),GMTSO("ET","C")
- +8 SET (GMTSI,GMTSC)=0
- FOR
- SET GMTSI=$ORDER(GMTSO("AL","B",GMTSI))
- if +GMTSI=0
- QUIT
- Begin DoDot:1
- +9 NEW GMTSIE
- SET GMTSEQ(GMTSI)=""
- SET GMTSIE=0
- +10 FOR
- SET GMTSIE=$ORDER(GMTSO("AL","B",GMTSI,GMTSIE))
- if +GMTSIE=0
- QUIT
- Begin DoDot:2
- +11 NEW GMTSF
- SET GMTSF=$PIECE($GET(GMTSO("AL",GMTSIE,0)),"^",2)
- if +GMTSF=0
- QUIT
- if '$DATA(GMTSO("ET",GMTSF,0))
- QUIT
- +12 SET GMTSC=GMTSC+1
- +13 SET (GMTSCUR(GMTSC),GMTSOLD(GMTSC))=GMTSI_"^"_GMTSF_"^"_$GET(GMTSO("ET",GMTSF,0))
- +14 SET GMTSOLD("B",GMTSI,GMTSC)=""
- End DoDot:2
- End DoDot:1
- +15 DO ORD
- if +($GET(GMTSEXIT))=0
- DO CHK
- +16 if +($GET(GMTSCHG))'>0
- WRITE !!,?2,"No Changes Made"
- +17 QUIT
- ORD ; Order of Entities
- +1 NEW GMTSI,GMTST,GMTSC,GMTSCNT,GMTSTOT,GMTSREM,GMTSSO,GMTSNXT,GMTSNXC,GMTSON
- +2 SET (GMTSSO,GMTSCNT,GMTSI,GMTSON)=0
- SET (GMTSTOT,GMTST)=$$TOT
- if +GMTSTOT'>1
- QUIT
- +3 SET GMTSEXIT=0
- SET GMTSCONT=$$CONT
- IF +GMTSCONT>0
- SET GMTSEXIT=1
- QUIT
- +4 WRITE !!," Please select the order in which you want these to be entities"
- +5 WRITE !," to be used."
- FOR
- if +($GET(GMTSEXIT))>0
- QUIT
- DO SO
- if +($GET(GMTSEXIT))>0
- QUIT
- if '$DATA(GMTSOLD)
- QUIT
- +6 SET GMTSEXIT=0
- +7 QUIT
- +8 ;
- SO ; Select Order
- +1 KILL GMTSOLD("B")
- NEW GMTSI,GMTSC,GMTSMAX,GMTSREO
- SET GMTSI=0
- SET GMTSREM=$$TOT
- +2 SET GMTSCNT=GMTSTOT-GMTSREM
- SET GMTSNXT=GMTSCNT+1
- SET GMTSSO=+($GET(GMTSSO))+1
- +3 SET GMTSNXC=$SELECT(GMTSNXT=1:(GMTSNXT_"st"),GMTSNXT=2:(GMTSNXT_"nd"),GMTSNXT=3:(GMTSNXT_"rd"),1:(GMTSNXT_"th"))
- +4 IF +GMTSREM=1
- SET Y=+GMTSREM
- DO SET
- QUIT
- +5 WRITE !
- DO SOL
- DO REO
- SET (GMTSC,GMTSI)=0
- +6 SET GMTSMAX=GMTSREM
- WRITE !
- NEW DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y
- +7 SET DIR(0)="NAO^1:"_GMTSMAX_":0"
- SET DIR("?")="^D SOH1^GMTSXAR"
- SET DIR("??")="^D SOH2^GMTSXAR"
- +8 SET DIR("A")=" Select the "_GMTSNXC_" entity to be used: "
- +9 KILL DIR("B")
- if +($ORDER(GMTSREO(0)))>0
- SET DIR("B")=+($ORDER(GMTSREO(0)))
- +10 DO ^DIR
- IF Y=""
- IF X="@"
- Begin DoDot:1
- +11 NEW GMTSD
- SET GMTSD=$PIECE($GET(^GMT(142.98,+($GET(GMTSUSR)),1)),"^",2)
- +12 SET GMTSEXIT="1^"_$SELECT($LENGTH(GMTSD):"",1:"exiting")
- +13 SET Y="@"
- KILL GMTSORD
- SET GMTSORD("@")=""
- End DoDot:1
- +14 if Y["^"!($DATA(DUOUT))!($DATA(DIROUT))
- SET GMTSEXIT="1^exiting"
- if $DATA(DTOUT)
- SET GMTSEXIT="1^try later"
- +15 IF +($GET(GMTSEXIT))>0
- WRITE $SELECT($LENGTH($PIECE(GMTSEXIT,"^",2)):"...",1:""),$PIECE(GMTSEXIT,"^",2)
- QUIT
- +16 IF +Y>0
- IF +Y'>GMTSREM
- DO SET
- +17 QUIT
- SOL ; List
- +1 NEW GMTSN,GMTSA,GMTST,GMTSC,GMTSI
- SET (GMTSC,GMTSI)=0
- FOR
- SET GMTSI=$ORDER(GMTSOLD(GMTSI))
- if +GMTSI=0
- QUIT
- Begin DoDot:1
- +2 SET GMTSC=GMTSC+1
- SET GMTSA=$PIECE(GMTSOLD(GMTSI),"^",4)
- SET GMTSN=$PIECE(GMTSOLD(GMTSI),"^",5)
- +3 SET GMTST=GMTSN_$SELECT(GMTSA="DEV"!(GMTSA="DIV")!(GMTSA="SYS")!(GMTSA="PKG")!(GMTSA="LOC")!(GMTSA="BED"):" level ",1:" ")_"defined Health Summary Types"
- +4 WRITE !,?5,$JUSTIFY(GMTSC,4)," ",GMTST
- End DoDot:1
- +5 QUIT
- SOH1 ; Help - Single ?
- +1 NEW GMTSC,GMTSI,GMTSN,GMTSCT
- SET (GMTSC,GMTSI)=0
- SET GMTSCT=+($GET(GMTSNXT))
- FOR
- SET GMTSI=$ORDER(GMTSOLD(GMTSI))
- if +GMTSI=0
- QUIT
- SET GMTSC=GMTSC+1
- +2 SET GMTSN=$SELECT(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:"")
- +3 IF '$LENGTH(GMTSN)
- IF +GMTSC>1
- WRITE !,?11,"Select a Health Summary Type entity to list"
- if $LENGTH($GET(GMTSNXC))
- WRITE " ",GMTSNXC
- WRITE " (1-",GMTSC,")",!
- +4 IF $LENGTH(GMTSN)
- IF +GMTSC>1
- WRITE !,?11,"Select a Health Summary Type entity to list ",GMTSN," (1-",GMTSC,")",!
- +5 DO SOL
- +6 QUIT
- SOH2 ; Help - Double ??
- +1 IF '$LENGTH($GET(GMTSPARM))
- DO SOH1
- QUIT
- +2 WRITE !,?11,"Parameter """,GMTSPARM,""" has multiple "
- +3 WRITE !,?11,"allowable entities for which Health Summary Types may"
- +4 WRITE !,?11,"be assigned and displayed on the CPRS reports tab. Now"
- +5 WRITE !,?11,"you must select the order in which you want these entites"
- +6 WRITE !,?11,"to be used by the site.",!
- +7 DO SOL
- +8 QUIT
- +9 ;
- +10 ; Arrange
- SET ; Set Order
- +1 DO REO
- NEW GMTSO
- SET GMTSO=+($ORDER(GMTSORD(" "),-1))+1
- +2 IF $LENGTH($PIECE($GET(GMTSREO(+($GET(Y)))),"^",2,299))
- Begin DoDot:1
- +3 SET GMTSON=$ORDER(GMTSEQ(GMTSON))
- +4 SET GMTSORD(GMTSO)=GMTSON_"^"_$PIECE($GET(GMTSREO(+Y)),"^",2,299)
- End DoDot:1
- +5 SET (GMTSC,GMTSI)=0
- +6 FOR
- SET GMTSI=$ORDER(GMTSOLD(GMTSI))
- if +GMTSI=0
- QUIT
- Begin DoDot:1
- +7 SET GMTSC=GMTSC+1
- IF GMTSC=+Y
- KILL GMTSOLD(GMTSI),GMTSREO(GMTSC)
- End DoDot:1
- +8 QUIT
- REO ; Re-order
- +1 KILL GMTSREO
- NEW GMTSC,GMTSI
- SET (GMTSC,GMTSI)=0
- +2 FOR
- SET GMTSI=$ORDER(GMTSOLD(GMTSI))
- if +GMTSI=0
- QUIT
- Begin DoDot:1
- +3 SET GMTSC=GMTSC+1
- SET GMTSREO(GMTSC)=$GET(GMTSOLD(GMTSI))
- End DoDot:1
- +4 QUIT
- TOT(X) ; Total Allowable Entities
- +1 NEW GMTSI
- SET (X,GMTSI)=0
- FOR
- SET GMTSI=$ORDER(GMTSOLD(GMTSI))
- if +GMTSI=0
- QUIT
- SET X=X+1
- +2 QUIT X
- CONT(X) ; Ask to Continue
- +1 if $ORDER(GMTSCUR(0))=0!('$LENGTH($GET(GMTSPARM)))!(+($GET(GMTSTOT))'>1)
- SET GMTSEXIT=1
- +2 if $ORDER(GMTSCUR(0))=0!('$LENGTH($GET(GMTSPARM)))!(+($GET(GMTSTOT))'>1)
- QUIT 0
- +3 WRITE !!!," Parameter """,GMTSPARM,""" has ",GMTSTOT," allowable entities"
- +4 WRITE !," which may have the Health Summary Types on the CPRS reports tab "
- +5 WRITE !," and are used in the following order:"
- +6 NEW DIR,DIROUT,DUOUT,DTOUT,GMTSA,GMTSN,GMTST,GMTSC,GMTSI
- DO CONTM
- +7 SET DIR("A")=" Are these in the correct order for your site? "
- +8 SET (DIR("?"),DIR("??"))="^D CONTH^GMTSXAR"
- SET DIR("B")="Y"
- SET DIR(0)="YAO"
- WRITE !
- DO ^DIR
- +9 SET X=+($GET(Y))
- QUIT X
- +10 QUIT 1
- CONTH ; Continue Help
- +1 WRITE !," Enter either 'Y' or 'N'"
- +2 DO CONTM
- QUIT
- CONTM ; Continue Menu
- +1 SET (GMTSC,GMTSI)=0
- FOR
- SET GMTSI=$ORDER(GMTSCUR(GMTSI))
- if +GMTSI=0
- QUIT
- Begin DoDot:1
- +2 SET GMTSA=$PIECE(GMTSCUR(GMTSI),"^",4)
- SET GMTSN=$PIECE(GMTSCUR(GMTSI),"^",5)
- +3 SET GMTST=GMTSN_$SELECT(GMTSA="DEV"!(GMTSA="DIV")!(GMTSA="SYS")!(GMTSA="PKG")!(GMTSA="LOC")!(GMTSA="BED"):" level ",1:" ")_"defined Health Summary Types"
- +4 SET GMTSC=GMTSC+1
- if GMTSC=1
- WRITE !
- WRITE !,$JUSTIFY(GMTSC,6)," ",GMTST
- End DoDot:1
- +5 QUIT
- CHK ; Check if OK
- +1 NEW GMTSC,GMTSI,GMTSA
- SET (GMTSC,GMTSI)=0
- FOR
- SET GMTSI=$ORDER(GMTSCUR(GMTSI))
- if +GMTSI=0
- QUIT
- if GMTSCUR(GMTSI)'[$GET(GMTSORD(GMTSI))
- SET GMTSC=1
- +2 IF 'GMTSC
- SET GMTSCHG=0
- QUIT
- +3 WRITE !!,?8,"You have selected to resequenced the Health Summary Type"
- +4 WRITE !,?8,"entities in the following order:",!
- +5 DO CHKM
- SET GMTSA=$$OK
- if +($GET(GMTSA))>0
- DO ED
- +6 QUIT
- CHKM ; Check (Menu)
- +1 NEW GMTSC,GMTSI
- SET (GMTSC,GMTSI)=0
- FOR
- SET GMTSI=$ORDER(GMTSCUR(GMTSI))
- if +GMTSI=0
- QUIT
- if GMTSCUR(GMTSI)'[$GET(GMTSORD(GMTSI))
- SET GMTSC=1
- +2 if 'GMTSC
- QUIT
- SET (GMTSC,GMTSI)=0
- FOR
- SET GMTSI=$ORDER(GMTSCUR(GMTSI))
- if +GMTSI=0
- QUIT
- Begin DoDot:1
- +3 SET GMTSC=GMTSC+1
- if GMTSC=1
- WRITE !,?13,"FROM (Current)",?33,"TO (Resequenced)",!,?13,"----------------",?33,"----------------"
- +4 WRITE !,?7,$JUSTIFY(GMTSC,4),?13,$PIECE($GET(GMTSCUR(GMTSI)),"^",5),?33,$PIECE($GET(GMTSORD(GMTSI)),"^",5)
- End DoDot:1
- +5 QUIT
- OK(X) ; Ask if OK
- +1 WRITE !
- NEW DIR,DIROUT,DUOUT,DTOUT
- SET (DIR("?"),DIR("??"))="^D OKH^GMTSXAR"
- +2 SET DIR("A")=" Is this OK? "
- SET DIR("B")="Y"
- SET DIR(0)="YAO"
- DO ^DIR
- SET X=+($GET(Y))
- QUIT X
- OKH ; OK Help
- +1 WRITE !," Enter either 'Y' or 'N'",!,!," Resequence entities:",!
- DO CHKM
- QUIT
- +2 ;
- ED ; Edit Record
- +1 NEW DIC,DA,DIE,DR,DIDEL,DTOUT,GMTSFI,GMTSI,GMTSEQ,GMTSCNT,GMTST
- +2 SET GMTSPI=+($GET(GMTSPI))
- SET GMTSCNT=0
- +3 IF GMTSPI'>0!(+($ORDER(GMTSORD(0)))'>0)!('$LENGTH($GET(GMTSPARM)))!($$PDN^GMTSXAW3(+GMTSPI)'=$GET(GMTSPARM))
- Begin DoDot:1
- +4 WRITE !,?5," Unable to resequence at this time."
- End DoDot:1
- QUIT
- +5 SET DA(1)=+($GET(GMTSPI))
- if DA(1)'>0
- QUIT
- SET (DIC,DIE)="^XTV(8989.51,"_DA(1)_",30,"
- SET DR=".02///^S X=$G(GMTSFI)"
- L ; Lock Record
- +1 LOCK +^XTV(8989.51,+($GET(GMTSPI)))
- SET GMTSCNT=GMTSCNT+1
- SET GMTST=$TEST
- +2 IF 'GMTST
- IF GMTSCNT'>3
- HANG 2
- GOTO L
- +3 IF 'GMTST
- IF GMTSCNT>3
- WRITE !," Another user is editing this entry.",!," Unable to resequence at this time."
- QUIT
- +4 SET GMTSI=0
- FOR
- SET GMTSI=$ORDER(GMTSORD(GMTSI))
- if +GMTSI=0
- QUIT
- Begin DoDot:1
- +5 SET GMTSFI=$PIECE(GMTSORD(GMTSI),"^",2)
- SET GMTSEQ=$PIECE(GMTSORD(GMTSI),"^",1)
- +6 SET DA=$$DA(DA(1),GMTSEQ)
- SET X=GMTSEQ
- DO ^DIE
- SET GMTSCHG=1
- End DoDot:1
- +7 LOCK -^XTV(8989.51,+($GET(GMTSPI)))
- +8 QUIT
- DA(GMTSI,X) ; Get DA
- +1 NEW DA,DIC,DTOUT,DUOUT,Y,GMTSM
- SET DA(1)=+($GET(GMTSI))
- SET X=+($GET(X))
- +2 SET DIC="^XTV(8989.51,"_DA(1)_",30,"
- SET DIC(0)="M"
- DO ^DIC
- SET X=+($GET(Y))
- QUIT X
- +3 QUIT
- +4 ;
- ADED ; Add/Edit
- +1 NEW X,Y,DA,DIC,DIE,DLAYGO,DR,DTOUT,DUOUT,GMTSCNT,GMTSDEF,GMTSENT
- +2 NEW GMTSM,GMTSMGR,GMTSNEW,GMTSPARM,GMTSPI,GMTST
- +3 SET GMTSMGR=$$MGR^GMTSXAW3
- if GMTSMGR'>0
- QUIT
- +4 SET GMTSPARM="ORWRP HEALTH SUMMARY TYPE LIST"
- +5 SET GMTSPI=$$PDI^GMTSXAW3(GMTSPARM)
- if +GMTSPI=0
- QUIT
- +6 WRITE !!
- if $LENGTH(GMTSPARM)
- WRITE "'"
- WRITE GMTSPARM
- if $LENGTH(GMTSPARM)
- WRITE "' "
- WRITE "ALLOWABLE ENTITIES",!
- +7 SET DA(1)=+($GET(GMTSPI))
- SET GMTSCNT=0
- +8 SET (DIC,DIE)="^XTV(8989.51,"_DA(1)_",30,"
- SET DIC(0)="AEQMLZ"
- +9 SET DIC("DR")=".02///^S X=$$AE^GMTSXAR(+($G(Y)))"
- +10 SET DLAYGO=""
- DO FIELD^DID(8989.51,30,"","SPECIFIER","GMTST(""DID"")","GMTSM(""ERR"")")
- +11 if $LENGTH($GET(GMTST("DID","SPECIFIER")))
- SET DIC("P")=$GET(GMTST("DID","SPECIFIER"))
- L2 ; Lock Record
- +1 LOCK +^XTV(8989.51,+($GET(GMTSPI)))
- SET GMTSCNT=GMTSCNT+1
- SET GMTST=$TEST
- +2 IF 'GMTST
- IF GMTSCNT'>3
- HANG 2
- GOTO L2
- +3 IF 'GMTST
- IF GMTSCNT>3
- WRITE !," Another user is editing this entry.",!," Unable to resequence at this time."
- QUIT
- +4 DO ^DIC
- SET GMTSNEW=+($PIECE($GET(Y),"^",3))
- if GMTSNEW>0
- QUIT
- if +Y'>0
- QUIT
- +5 NEW DIC,DIE
- SET DA(1)=GMTSPI
- SET DA=+($GET(Y))
- SET (DIC,DIE)="^XTV(8989.51,"_DA(1)_",30,"
- +6 SET DA=+($GET(Y))
- SET DR=".01;.02///^S X=$$AE^GMTSXAR("_DA_")"
- +7 DO ^DIE
- LOCK -^XTV(8989.51,+($GET(GMTSPI)))
- +8 QUIT
- AE(X) ; Allowable Entity
- +1 NEW DA,DIC,DTOUT,DUOUT,Y,GMTSPARM,GMTSPI,GMTSENT,GMTSDEF
- +2 SET GMTSDEF=""
- SET GMTSENT=+($GET(X))
- SET GMTSPARM="ORWRP HEALTH SUMMARY TYPE LIST"
- +3 SET GMTSPI=$$PDI^GMTSXAW3(GMTSPARM)
- if +GMTSPI=0
- QUIT ""
- +4 if +GMTSENT>0
- SET GMTSDEF=$$GET1^DIQ(8989.513,(GMTSENT_","_GMTSPI_","),.02)
- +5 NEW DA,DIC,DTOUT,DUOUT,Y
- SET DIC="^XTV(8989.518,"
- SET DIC(0)="AEMQ"
- +6 SET DIC("S")="I Y'=3.5&(Y'=9.4)&(Y'=44)&(Y'=404.51)&(Y'=405.4)"
- +7 if $LENGTH($GET(GMTSDEF))
- SET DIC("B")=GMTSDEF
- DO ^DIC
- SET X=+($GET(Y))
- +8 QUIT X