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")