Routine: GMTSXPD4

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

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

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

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

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

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

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

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

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

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

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

GMTSXPD4.m