Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMTSXPD4

GMTSXPD4.m

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