148 lines
7.1 KiB
Mathematica
148 lines
7.1 KiB
Mathematica
|
GMTSXPD4 ; SLC/KER - Health Summary Dist (Re-Build) ; 08/27/2002
|
||
|
|
;;2.7;Health Summary;**35,56**;Oct 20, 1995
|
||
|
|
;
|
||
|
|
; External References
|
||
|
|
; DBIA 10013 ^DIK (file #142)
|
||
|
|
; DBIA 2052 $$GET1^DID
|
||
|
|
; DBIA 10018 ^DIE (file #142)
|
||
|
|
; DBIA 10086 HOME^%ZIS
|
||
|
|
; DBIA 10060 ^VA(200,
|
||
|
|
; DBIA 2056 $$GET1^DIQ (file 200)
|
||
|
|
; DBIA 10141 BMES^XPDUTL
|
||
|
|
; DBIA 10141 MES^XPDUTL
|
||
|
|
;
|
||
|
|
Q
|
||
|
|
; Re-Build Ad Hoc Health Summary Type
|
||
|
|
;
|
||
|
|
; Input Variables INCLUDE
|
||
|
|
; 0 exclude DISABLED components
|
||
|
|
; 1 include DISABLED components
|
||
|
|
;
|
||
|
|
IN ; Re-Build w/INCLUDE
|
||
|
|
N INCLUDE S INCLUDE=1 D RB Q
|
||
|
|
EX ; Re-Build w/EXCLUDE
|
||
|
|
N INCLUDE S INCLUDE=0 D RB Q
|
||
|
|
RB ; Re-Build (main)
|
||
|
|
N GMTSENV S GMTSENV=$$ENV Q:'GMTSENV
|
||
|
|
N DA,DIC,DIE,DIK,DLAYGO,DR,GMTSC,GMTSDA,GMTSDIAB,GMTSE,GMTSEG,GMTSEL
|
||
|
|
N GMTSELC,GMTSELT,GMTSEQ,GMTSI,GMTSICD,GMTSIFN,GMTSISEQ,GMTSITEM
|
||
|
|
N GMTSJ,GMTSL,GMTSLOC,GMTSNAR,GMTSCPT,GMTSNEW,GMTSNM,GMTSOCC,GMTSOK
|
||
|
|
N GMTSORD,GMTSQ,GMTST1,GMTST2,GMTST3,GMTSTIM,GMTSTYP,X,Y
|
||
|
|
S GMTSOK=0,GMTSE=59,GMTSC=0 D BM(" Ad Hoc Summary") S GMTST1=" Gathering Ad Hoc Summary information",GMTST2=" Purging old Ad Hoc Summary",GMTST3=" Rebuilding Ad Hoc Summary"
|
||
|
|
D M($G(GMTST1)) N GMTSNEW,GMTSTYP,DLAYGO S DLAYGO=142
|
||
|
|
S DIC=142,DIC(0)="LXF",X="GMTS HS ADHOC OPTION" S Y=$$TYPE^GMTSULT K DIC
|
||
|
|
I +Y'>0 D BM("** GMTS AD HOC OPTION Summary Type is missing **") Q
|
||
|
|
D GA,RN D:+($G(GMTSOK))>0 BM(" Ad Hoc Health Summary successfully rebuilt")
|
||
|
|
D:+($G(GMTSOK))'>0 BM(" Failed to successfully rebuild the Ad Hoc Health Summary")
|
||
|
|
Q
|
||
|
|
GA ; Gather Information
|
||
|
|
N GMTSL,GMTSQ,GMTSC,GMTSE
|
||
|
|
S GMTSE=59,GMTSC=0,GMTSL=$L($G(GMTST1))
|
||
|
|
S (GMTSIFN,GMTSTYP)=+Y,GMTSNEW=+$P(Y,"^",3)
|
||
|
|
S:'$D(^GMT(142,GMTSIFN,1,0)) ^(0)="^142.01IA^0^0"
|
||
|
|
S GMTSC=0,GMTSNM="" F GMTSC=1:1 S GMTSNM=$O(^GMT(142.1,"B",GMTSNM)) Q:GMTSNM']"" S GMTSC=+($G(GMTSC))+1
|
||
|
|
S GMTSC=GMTSC-1,GMTSQ=GMTSC\(GMTSE-$L(GMTST1))
|
||
|
|
S GMTSC=0,GMTSNM="" F GMTSC=1:1 S GMTSNM=$O(^GMT(142.1,"B",GMTSNM)) Q:GMTSNM']"" D
|
||
|
|
. S GMTSJ=$O(^(GMTSNM,0)) Q:GMTSJ'>0 D LA
|
||
|
|
. Q:$D(GMTSQT) Q:+GMTSQ'>0
|
||
|
|
. S GMTSC=GMTSC+1 S:GMTSC#GMTSQ=0 GMTSL=GMTSL+1 Q:GMTSL>GMTSE
|
||
|
|
. W:GMTSC#GMTSQ=0 "."
|
||
|
|
I '$D(GMTSQT),GMTSL'>GMTSE F S GMTSL=GMTSL+1 Q:GMTSL>GMTSE W "."
|
||
|
|
W:'$D(GMTSQT) ?GMTSE," < done >"
|
||
|
|
S GMTSI=0 I 'GMTSNEW D PA
|
||
|
|
Q
|
||
|
|
PA ; Purge Ad Hoc Health Summary
|
||
|
|
N GMTSI,GMTSL,GMTSQ,GMTSC,GMTSE S GMTSE=59,GMTSL=$L($G(GMTST2)) D M($G(GMTST2))
|
||
|
|
S (GMTSC,GMTSI)=0 F S GMTSI=$O(^GMT(142,GMTSIFN,1,GMTSI)) Q:GMTSI'>0 S GMTSC=+($G(GMTSC))+1
|
||
|
|
S GMTSC=GMTSC-1,GMTSQ=GMTSC\(GMTSE-$L(GMTST1))
|
||
|
|
S (GMTSC,GMTSI)=0 F S GMTSI=$O(^GMT(142,GMTSIFN,1,GMTSI)) Q:GMTSI'>0 D
|
||
|
|
. N DA,DIK S U="^",DA(1)=GMTSIFN,DA=GMTSI,DIK="^GMT(142,"_GMTSIFN_",1," D ^DIK
|
||
|
|
. Q:$D(GMTSQT) Q:+GMTSQ'>0
|
||
|
|
. S GMTSC=GMTSC+1 S:GMTSC#GMTSQ=0 GMTSL=GMTSL+1 Q:GMTSL>GMTSE
|
||
|
|
. W:GMTSC#GMTSQ=0 "."
|
||
|
|
I '$D(GMTSQT),GMTSL'>GMTSE F S GMTSL=GMTSL+1 Q:GMTSL>GMTSE W "."
|
||
|
|
W:'$D(GMTSQT) ?GMTSE," < done >"
|
||
|
|
Q
|
||
|
|
RN ; Renumber - Resets ^GMT(142,GMTSIFN,1,
|
||
|
|
N DA,DR,DIE,GMTSEQ,GMTSL
|
||
|
|
N GMTSL,GMTSQ,GMTSC,GMTSE S GMTSE=59,GMTSL=$L($G(GMTST3)) D M($G(GMTST3))
|
||
|
|
S (GMTSEQ,GMTSC)=0 F S GMTSEQ=$O(GMTSEG(GMTSEQ)) Q:GMTSEQ'>0 S GMTSC=+($G(GMTSC))+1
|
||
|
|
S GMTSC=GMTSC-1,GMTSQ=GMTSC\(GMTSE-$L(GMTST3))
|
||
|
|
S (GMTSEQ,GMTSC)=0 F S GMTSEQ=$O(GMTSEG(GMTSEQ)) Q:GMTSEQ'>0 D
|
||
|
|
. K DA S DIE="^GMT(142,"_GMTSIFN_",1,",DA(1)=GMTSIFN D AC
|
||
|
|
. Q:$D(GMTSQT) Q:+GMTSQ'>0
|
||
|
|
. S GMTSC=GMTSC+1 S:GMTSC#GMTSQ=0 GMTSL=GMTSL+1 Q:GMTSL>GMTSE
|
||
|
|
. W:GMTSC#GMTSQ=0 "."
|
||
|
|
I '$D(GMTSQT),GMTSL'>GMTSE F S GMTSL=GMTSL+1 Q:GMTSL>GMTSE W "."
|
||
|
|
W:'$D(GMTSQT) ?GMTSE," < done >" S GMTSOK=1
|
||
|
|
Q
|
||
|
|
LA ; Load Array GMTSEG(#)
|
||
|
|
N GMTSOCC,GMTSTIM,GMTSORD,GMTSLOC,GMTSICD,GMTSNAR,GMTSCPT
|
||
|
|
Q:'$D(^GMT(142.1,GMTSJ,0))
|
||
|
|
S GMTSORD=$O(^GMT(142,"AE",GMTSJ,GMTSTYP,0))
|
||
|
|
I GMTSORD>0 D
|
||
|
|
. S GMTSOCC=$S($P(^GMT(142.1,GMTSJ,0),"^",5)="Y":$P($G(^GMT(142,GMTSTYP,1,GMTSORD,0)),"^",3),1:"")
|
||
|
|
. S GMTSTIM=$S($P(^GMT(142.1,GMTSJ,0),"^",3)="Y":$P($G(^GMT(142,GMTSTYP,1,GMTSORD,0)),"^",4),1:"")
|
||
|
|
. S GMTSLOC=$S($P(^GMT(142.1,GMTSJ,0),"^",10)="Y":$P($G(^GMT(142,GMTSTYP,1,GMTSORD,0)),"^",6),1:"")
|
||
|
|
. S GMTSICD=$S($P(^GMT(142.1,GMTSJ,0),"^",11)="Y":$P($G(^GMT(142,GMTSTYP,1,GMTSORD,0)),"^",7),1:"")
|
||
|
|
. S GMTSNAR=$S($P(^GMT(142.1,GMTSJ,0),"^",12)="Y":$P($G(^GMT(142,GMTSTYP,1,GMTSORD,0)),"^",8),1:"")
|
||
|
|
. S GMTSCPT=$S($P(^GMT(142.1,GMTSJ,0),"^",14)="Y":$P($G(^GMT(142,GMTSTYP,1,GMTSORD,0)),"^",9),1:"")
|
||
|
|
E D
|
||
|
|
. S GMTSOCC=$S($P(^GMT(142.1,GMTSJ,0),"^",5)="Y":10,1:"")
|
||
|
|
. S GMTSTIM=$S($P(^GMT(142.1,GMTSJ,0),"^",3)="Y":"1Y",1:"")
|
||
|
|
. S GMTSLOC=$S($P(^GMT(142.1,GMTSJ,0),"^",10)="Y":"Y",1:"")
|
||
|
|
. S GMTSICD=$S($P(^GMT(142.1,GMTSJ,0),"^",11)="Y":"L",1:"")
|
||
|
|
. S GMTSNAR=$S($P(^GMT(142.1,GMTSJ,0),"^",12)="Y":"Y",1:"")
|
||
|
|
. S GMTSCPT=$S($P(^GMT(142.1,GMTSJ,0),"^",12)="Y":"Y",1:"")
|
||
|
|
; Defaults for CPT Modifiers
|
||
|
|
S:$P(^GMT(142.1,GMTSJ,0),"^",14)="Y"&(GMTSCPT="") GMTSCPT="Y"
|
||
|
|
S:$$GET1^DID(142.1,14,,"LABEL")="" GMTSCPT=""
|
||
|
|
D SG
|
||
|
|
Q
|
||
|
|
SG ; Set GMTSEG(#) Component
|
||
|
|
; Disabled
|
||
|
|
N GMTSDIAB S GMTSDIAB=$S($P(^GMT(142.1,GMTSJ,0),"^",6)="P":1,$P(^(0),"^",6)="T":1,1:0) I (INCLUDE=0),(GMTSDIAB=1) Q
|
||
|
|
; Include
|
||
|
|
S GMTSEG(GMTSC)=(5*GMTSC)_"^"_GMTSJ_"^"_GMTSOCC_"^"_GMTSTIM_"^^"_GMTSLOC_"^"_GMTSICD_"^"_GMTSNAR_"^"_GMTSCPT I GMTSORD>0 D SL
|
||
|
|
Q
|
||
|
|
SL ; Set GMTSEG(#,#) Selection item
|
||
|
|
N GMTSELT,GMTSITEM
|
||
|
|
S GMTSELT=0 F S GMTSELT=$O(^GMT(142,GMTSTYP,1,+GMTSORD,1,GMTSELT)) Q:GMTSELT'>0 D
|
||
|
|
. S GMTSITEM=^(GMTSELT,0) S GMTSEG(GMTSC,GMTSELT)=GMTSITEM
|
||
|
|
Q
|
||
|
|
AC ; Add Components to Ad Hoc Summary
|
||
|
|
N GMTSISEQ,DA,DIE,DR,GMTSELC,GMTSDA,GMTSEL
|
||
|
|
S (GMTSISEQ,DA)=GMTSEQ*5,DIE="^GMT(142,"_GMTSIFN_",1,",DA(1)=GMTSIFN
|
||
|
|
S DR=".01///"_DA
|
||
|
|
S:$L($P(GMTSEG(GMTSEQ),"^",2)) DR=DR_";1///"_$P(GMTSEG(GMTSEQ),"^",2)
|
||
|
|
S:$L($P(GMTSEG(GMTSEQ),"^",3)) DR=DR_";2///"_$P(GMTSEG(GMTSEQ),"^",3)
|
||
|
|
S:$L($P(GMTSEG(GMTSEQ),"^",4)) DR=DR_";3///"_$P(GMTSEG(GMTSEQ),"^",4)
|
||
|
|
S:$L($P(GMTSEG(GMTSEQ),"^",5)) DR=DR_";5///"_$P(GMTSEG(GMTSEQ),"^",5)
|
||
|
|
S:$L($P(GMTSEG(GMTSEQ),"^",6)) DR=DR_";6///"_$P(GMTSEG(GMTSEQ),"^",6)
|
||
|
|
S:$L($P(GMTSEG(GMTSEQ),"^",7)) DR=DR_";7///"_$P(GMTSEG(GMTSEQ),"^",7)
|
||
|
|
S:$L($P(GMTSEG(GMTSEQ),"^",8)) DR=DR_";8///"_$P(GMTSEG(GMTSEQ),"^",8)
|
||
|
|
S:$L($P($G(GMTSEG(GMTSEQ)),"^",9))>0&($L($$GET1^DID(142.1,14,,"LABEL"))>0) DR=DR_";9///"_$P(GMTSEG(GMTSEQ),"^",9)
|
||
|
|
D ^DIE S (GMTSELC,GMTSEL)=0 F S GMTSEL=$O(GMTSEG(GMTSEQ,GMTSEL)) Q:'GMTSEL D AS
|
||
|
|
I GMTSELC>0 S:'$D(^GMT(142,GMTSIFN,1,GMTSISEQ,1,0)) ^(0)="^142.14V^"_GMTSDA_"^"_GMTSELC
|
||
|
|
Q
|
||
|
|
AS ; Add Selection Items to Ad Hoc Summary
|
||
|
|
N DIE,DA,DR
|
||
|
|
S:'$D(^GMT(142,GMTSIFN,1,GMTSISEQ,1,0)) ^(0)="^142.14V^^"
|
||
|
|
S DIE="^GMT(142,"_GMTSIFN_",1,"_GMTSISEQ_",1,"
|
||
|
|
S DA(2)=GMTSIFN,DA(1)=GMTSISEQ,DA=GMTSEL
|
||
|
|
S DR=".01////"_"^S X=GMTSEG(GMTSEQ,GMTSEL)" D ^DIE
|
||
|
|
S GMTSDA=DA,GMTSELC=GMTSELC+1
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
; Misc
|
||
|
|
ENV(X) ; Environment check
|
||
|
|
D HOME^%ZIS I +($G(DUZ))=0 D BM(" User (DUZ) not defined"),M(" ") Q 0
|
||
|
|
I '$L($$GET1^DIQ(200,(+($G(DUZ))_","),.01)) D BM(" Invalid User defined (DUZ)"),M(" ") Q 0
|
||
|
|
Q 1
|
||
|
|
BM(X) ; Blank Line with Message
|
||
|
|
Q:$D(GMTSQT) D:$D(XPDNM) BMES^XPDUTL($G(X)) W:'$D(XPDNM) !!,$G(X) Q
|
||
|
|
M(X) ; Message
|
||
|
|
Q:$D(GMTSQT) D:$D(XPDNM) MES^XPDUTL($G(X)) W:'$D(XPDNM) !,$G(X) Q
|
||
|
|
UP(X) ; Uppercase
|
||
|
|
Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|