| 1 | GMTSXPD3 ; SLC/KER - Health Summary Dist (Index/ADH) ; 07/18/2000
|
|---|
| 2 | ;;2.7;Health Summary;**35,37**;Oct 20, 1995
|
|---|
| 3 | Q
|
|---|
| 4 | ;
|
|---|
| 5 | BUILD ; Rebuild AD Hoc Health Summary
|
|---|
| 6 | ; Set Variable GMTSQT for QUIET Rebuild
|
|---|
| 7 | N GMTSENV,DIK,DA,X,Y,INCLUDE S GMTSENV=$$ENV Q:'GMTSENV S INCLUDE=0 D M(" "),RC,RT,RB
|
|---|
| 8 | Q
|
|---|
| 9 | BUILDQ ; Quiet Rebuild
|
|---|
| 10 | N GMTSQT S GMTSQT="" D BUILD Q
|
|---|
| 11 | ;
|
|---|
| 12 | TSK(X) ; Tasked Rebuild
|
|---|
| 13 | ; Returns 0 Not tasked
|
|---|
| 14 | ; -1 Currently running
|
|---|
| 15 | ; # Task Number
|
|---|
| 16 | ;
|
|---|
| 17 | S X=0,ZTRTN="TSKB^GMTSXPD3",ZTDESC="Rebuilding AD Hoc Health Summary",ZTIO="",ZTDTH=$H
|
|---|
| 18 | S:$D(^TMP("GMTSXPD3")) X=-1 Q:X<0 X
|
|---|
| 19 | ; DBIA 10063 call ^%ZTLOAD
|
|---|
| 20 | I '$D(^TMP("GMTSXPD3")) S ^TMP("GMTSXPD3")="" D ^%ZTLOAD
|
|---|
| 21 | S X=+($G(ZTSK))
|
|---|
| 22 | ; DBIA 10086 call HOME^%ZIS
|
|---|
| 23 | D HOME^%ZIS K ZTSAVE,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK
|
|---|
| 24 | Q X
|
|---|
| 25 | TSKB S ^TMP("GMTSXPD3")="" S:$D(ZTQUEUED) ZTREQ="@" D BUILDQ K ^TMP("GMTSXPD3")
|
|---|
| 26 | Q
|
|---|
| 27 | TO(GMTSCOM,GMTSTIM,GMTSOCC) ; Update Ad Hoc default time and occurrences
|
|---|
| 28 | N GMTSTAD,GMTSTAS,GMTSTAN,GMTSTNN,GMTSTOT,GMTSTOC,GMTSTOO,GMTSTAV
|
|---|
| 29 | N GMTSTTA,GMTSTOA,GMTSTQN,GMTST1,GMTST2,GMTSTLL,GMTSOLL
|
|---|
| 30 | S GMTSCOM=$G(GMTSCOM) Q:'$L(GMTSCOM) S GMTSTIM=$$UP($G(GMTSTIM)),GMTSTAD=$$A S:+GMTSTIM=0 GMTSTIM=""
|
|---|
| 31 | S GMTSOCC=+($G(GMTSOCC)) S:GMTSOCC=0 GMTSOCC="" S GMTSCOM=$$R(GMTSCOM),GMTSTOC=$$C(GMTSCOM),GMTSTTA=0 S:GMTSCOM=GMTSTOC GMTSTTA=$$TA(GMTSCOM)
|
|---|
| 32 | S GMTSTOA=0 S:GMTSCOM=GMTSTOC GMTSTOA=$$OA(GMTSCOM) S GMTSTOT=$$T(GMTSTIM),GMTSTOO=$$O(GMTSOCC)
|
|---|
| 33 | S GMTSTAD=$$A,GMTSTAS=$$S(GMTSTAD,GMTSTOC),GMTSTAN=$$N(GMTSTAD,GMTSTAS),GMTSTAV=""
|
|---|
| 34 | S:$L(GMTSTAN) GMTSTAV=@GMTSTAN S GMTSTNN=GMTSTAV,GMTSTQN="" S:$L(GMTSTNN,"^")>2&(GMTSTOO=GMTSOCC) $P(GMTSTNN,"^",3)=GMTSOCC
|
|---|
| 35 | S:$L(GMTSOCC)&(GMTSTOO=GMTSOCC) $P(GMTSTNN,"^",3)=GMTSOCC S:$L(GMTSTNN,"^")>3&(GMTSTOT=GMTSTIM) $P(GMTSTNN,"^",4)=GMTSTIM
|
|---|
| 36 | S:$L(GMTSTIM)&(GMTSTOT=GMTSTIM) $P(GMTSTNN,"^",4)=GMTSTIM S:'GMTSTTA&($L(GMTSTNN,"^")>3) GMTSTNN=$P(GMTSTNN,"^",1,3)
|
|---|
| 37 | S:'GMTSTTA&($P(GMTSTNN,"^",3)="") GMTSTNN=$P(GMTSTNN,"^",1,2) S:'GMTSTOA&($L(GMTSTNN,"^")=3) GMTSTNN=$P(GMTSTNN,"^",1,2)
|
|---|
| 38 | S:'GMTSTOA&($L(GMTSTNN,"^")>3) $P(GMTSTNN,"^",3)=""
|
|---|
| 39 | S:+GMTSTAS>0&($D(^GMT(142,+($G(GMTSTAD)),1,+GMTSTAS,0))) $P(GMTSTQN,"^",1)=GMTSTAS
|
|---|
| 40 | S:+GMTSTOC>0&(GMTSTOC=GMTSCOM)&($D(^GMT(142.1,+($G(GMTSTOC)),0))) $P(GMTSTQN,"^",2)=GMTSTOC
|
|---|
| 41 | S:+GMTSTOA>0&($L(GMTSTOO)) $P(GMTSTQN,"^",3)=GMTSTOO,GMTSOCC=GMTSTOO
|
|---|
| 42 | S:+GMTSTTA>0&($L(GMTSTOT)) $P(GMTSTQN,"^",4)=GMTSTOT,GMTSTIM=GMTSTOT
|
|---|
| 43 | S:+GMTSTOA=0&($L(GMTSTOO)) GMTSTOO="" S:+GMTSTTA=0&($L(GMTSTOT)) GMTSTOT=""
|
|---|
| 44 | Q:'$L(GMTSTAN) Q:'$L(GMTSTQN) Q:'$D(^GMT(142,+($G(GMTSTAD)),0)) Q:'$D(^GMT(142,+($G(GMTSTAD)),1,+($G(GMTSTAS)),0))
|
|---|
| 45 | Q:GMTSTOT'=GMTSTIM Q:GMTSTOO'=GMTSOCC Q:GMTSCOM'=GMTSTOC Q:$P(GMTSTNN,"^",1,2)'=$P(GMTSTQN,"^",1,2)
|
|---|
| 46 | S GMTSCOM=$P(GMTSTQN,"^",2),GMTSOCC=$P(GMTSTQN,"^",3),GMTSTIM=$P(GMTSTQN,"^",4)
|
|---|
| 47 | Q:+GMTSCOM=0 S GMTSCOM=$P($G(^GMT(142.1,+GMTSCOM,0)),"^",1) Q:'$L(GMTSCOM)
|
|---|
| 48 | S GMTST1=" Setting time and occurrence limits for GMTS HS ADHOC OPTION component" D BM(GMTST1)
|
|---|
| 49 | S GMTSOLL=$$OLL(+GMTSOCC),GMTSTLL=$$TLL(GMTSTIM)
|
|---|
| 50 | I $L(GMTSOLL),$L(GMTSTLL) D
|
|---|
| 51 | . S GMTST1=" "_GMTSCOM_" (Limits - "_GMTSTLL_" and "_GMTSOLL_")" D M(GMTST1)
|
|---|
| 52 | I '$L(GMTSOLL)!('$L(GMTSTLL)) D
|
|---|
| 53 | . S GMTST1=" "_GMTSCOM D M(GMTST1)
|
|---|
| 54 | . S GMTST1=$S($L($G(GMTSTIM))&($L($G(GMTSTLL))):" Limits: ",1:" Time Limits: ")
|
|---|
| 55 | . S GMTST2=$S($L($G(GMTSTIM))&('$L($G(GMTSTLL))):GMTSTIM,$L($G(GMTSTIM))&($L($G(GMTSTLL))):GMTSTLL,1:"No time limit <null>") D M((GMTST1_GMTST2))
|
|---|
| 56 | . S GMTST1=$S($L($G(GMTSTIM))&($L($G(GMTSTLL))):" ",1:" Occurrence Limits: ")
|
|---|
| 57 | . S GMTST2=$S($L($G(GMTSOCC))&('$L($G(GMTSOLL))):GMTSOCC,$L($G(GMTSOCC))&($L($G(GMTSOLL))):GMTSOLL,1:"No occurrence limit <null>") D M((GMTST1_GMTST2))
|
|---|
| 58 | S @GMTSTAN=GMTSTQN
|
|---|
| 59 | Q
|
|---|
| 60 | ;
|
|---|
| 61 | ; Indexing
|
|---|
| 62 | RT ; Re-Index HS Type File
|
|---|
| 63 | N GMTST,GMTSL,GMTSQ,GMTSC,GMTSE,DA,DIK,DIC,X,Y
|
|---|
| 64 | S U="^",GMTSE=59,GMTST=" Re-Indexing Health Summary Type file "
|
|---|
| 65 | S GMTSL=$L(GMTST),(GMTSC,DA)=0 F S DA=$O(^GMT(142,DA)) Q:+DA=0 S GMTSC=GMTSC+1
|
|---|
| 66 | S GMTSC=GMTSC-1,GMTSQ=GMTSC\(GMTSE-$L(GMTST)) S:GMTSQ'>0 GMTSQ=1 D M(GMTST)
|
|---|
| 67 | S DIK="^GMT(142,",(GMTSC,DA)=0 F S DA=$O(^GMT(142,DA)) Q:+DA=0 D
|
|---|
| 68 | . ; DBIA 10013 call IX^DIK
|
|---|
| 69 | . D IX^DIK Q:$D(GMTSQT)
|
|---|
| 70 | . S GMTSC=GMTSC+1 S:GMTSC#GMTSQ=0 GMTSL=GMTSL+1 Q:GMTSL>GMTSE
|
|---|
| 71 | . W:GMTSC#GMTSQ=0 "."
|
|---|
| 72 | I '$D(GMTSQT),GMTSL'>GMTSE F S GMTSL=GMTSL+1 Q:GMTSL>GMTSE W "."
|
|---|
| 73 | W:'$D(GMTSQT) ?GMTSE," < done >"
|
|---|
| 74 | Q
|
|---|
| 75 | RC ; Re-Index HS Component File
|
|---|
| 76 | N GMTST,GMTSL,GMTSQ,GMTSC,GMTSE,DA,DIK,DIC,X,Y
|
|---|
| 77 | S U="^",GMTSE=59,GMTST=" Re-Indexing Health Summary Component file ",GMTSL=$L(GMTST),(GMTSC,DA)=0
|
|---|
| 78 | F S DA=$O(^GMT(142.1,DA)) Q:+DA=0 S GMTSC=GMTSC+1
|
|---|
| 79 | S GMTSC=GMTSC-1,GMTSQ=GMTSC\(GMTSE-$L(GMTST)) S:GMTSQ'>0 GMTSQ=1 D M(GMTST)
|
|---|
| 80 | S DIK="^GMT(142.1,",(GMTSC,DA)=0 F S DA=$O(^GMT(142.1,DA)) Q:+DA=0 D
|
|---|
| 81 | . ; DBIA 10013 call IX^DIK
|
|---|
| 82 | . D IX^DIK Q:$D(GMTSQT)
|
|---|
| 83 | . S GMTSC=GMTSC+1 S:GMTSC#GMTSQ=0 GMTSL=GMTSL+1 Q:GMTSL>GMTSE
|
|---|
| 84 | . W:GMTSC#GMTSQ=0 "."
|
|---|
| 85 | I '$D(GMTSQT),GMTSL'>GMTSE F S GMTSL=GMTSL+1 Q:GMTSL>GMTSE W "."
|
|---|
| 86 | W:'$D(GMTSQT) ?GMTSE," < done >"
|
|---|
| 87 | Q
|
|---|
| 88 | RA ; Re-Index HS Type "Ad Hoc"
|
|---|
| 89 | ; DBIA 10013 call IX1^DIK
|
|---|
| 90 | N GMTST,DA,DIK S DIK="^GMT(142,",DA=$$A,U="^" Q:+DA=0 D IX1^DIK
|
|---|
| 91 | Q
|
|---|
| 92 | RB ; Re-Build Ad Hoc Health Summary Type
|
|---|
| 93 | D RB^GMTSXPD4 Q
|
|---|
| 94 | ;
|
|---|
| 95 | ; Check Input
|
|---|
| 96 | T(X) ; Time Input Transform
|
|---|
| 97 | ; DBIA 10104 call $$UP^XLFSTR
|
|---|
| 98 | S X=$$UP^XLFSTR($G(X)) S:$L(X)>5!($L(X)<1)!'((X?1N.N1U)!(X?1N.N1"D")!(X?1N.N1"W")!(X?1N.N1"M")!(X?1N.N1"Y")) X="1Y" Q X
|
|---|
| 99 | O(X) ; Occurrence Input Transform
|
|---|
| 100 | S X=$G(X) S:+X'=X!(X>99999)!(X<1)!(X?.E1"."1N.N) X="10" Q X
|
|---|
| 101 | C(X) ; Component Input Transform
|
|---|
| 102 | S X=$G(X) Q:'$L(X) "Error" Q:+X'>0 "Error" Q:'$D(^GMT(142.1,+X,0)) "Error" S X=+X Q X
|
|---|
| 103 | R(X) ; Resolve Pointer
|
|---|
| 104 | S X=$G(X) Q:'$L(X) "" N GMTSA S GMTSA=X I $D(^GMT(142.1,+X,0)) S X=+X Q X
|
|---|
| 105 | S:$D(^GMT(142.1,"B",X)) GMTSA=+($O(^GMT(142.1,"B",X,0))) S:GMTSA=X&($D(^GMT(142.1,"B",$$UP(X)))) GMTSA=+($O(^GMT(142.1,"B",$$UP(X),0))) I GMTSA'=X S X=GMTSA Q X
|
|---|
| 106 | S:GMTSA=X&($D(^GMT(142.1,"C",X))) GMTSA=+($O(^GMT(142.1,"C",X,0))) S:GMTSA=X&($D(^GMT(142.1,"C",$$UP(X)))) GMTSA=+($O(^GMT(142.1,"C",$$UP(X),0))) I GMTSA'=X S X=GMTSA Q X
|
|---|
| 107 | S:GMTSA=X&($D(^GMT(142.1,"D",X))) GMTSA=+($O(^GMT(142.1,"D",X,0))) S:GMTSA=X&($D(^GMT(142.1,"D",$$UP(X)))) GMTSA=+($O(^GMT(142.1,"D",$$UP(X),0))) I GMTSA'=X S X=GMTSA Q X
|
|---|
| 108 | Q ""
|
|---|
| 109 | A(X) ; Ad Hoc IEN
|
|---|
| 110 | S X=0 S X=+($O(^GMT(142,"AB","GMTS HS ADHOC OPTION",0))) Q:+X>0 +X
|
|---|
| 111 | S X=+($O(^GMT(142,"B","GMTS HS ADHOC OPTION",0))) Q:+X>0 +X
|
|---|
| 112 | S X=+($O(^GMT(142,"E","Ad Hoc Health Summary Type",0))) Q:+X>0 +X Q 0
|
|---|
| 113 | S(GMTSA,GMTSC) ; Structure IEN
|
|---|
| 114 | N GMTST1,GMTST2 S GMTSA=+($G(GMTSA)) Q:GMTSA=0 ""
|
|---|
| 115 | S GMTSC=+($G(GMTSC)) Q:GMTSC=0 ""
|
|---|
| 116 | Q:'$D(^GMT(142,GMTSA,1,"C",GMTSC)) ""
|
|---|
| 117 | Q:'$D(^GMT(142,"AE",GMTSC,GMTSA)) ""
|
|---|
| 118 | S GMTST1=+($O(^GMT(142,GMTSA,1,"C",GMTSC,0)))
|
|---|
| 119 | S GMTST2=+($O(^GMT(142,"AE",GMTSC,GMTSA,0)))
|
|---|
| 120 | Q:GMTST1'=GMTST2!(GMTST1=0)!(GMTST2=0) "" S GMTSA=GMTST1 Q GMTSA
|
|---|
| 121 | N(GMTSA,GMTSC) ; Structure IEN
|
|---|
| 122 | N GMTST1,GMTST2
|
|---|
| 123 | S GMTSA=+($G(GMTSA)) Q:GMTSA=0 "" S GMTSC=+($G(GMTSC)) Q:GMTSC=0 ""
|
|---|
| 124 | S GMTST1="^GMT(142,"_GMTSA_",1,"_GMTSC_",0)",GMTST2=$G(@GMTST1)
|
|---|
| 125 | Q:'$D(@GMTST1) "" Q:'$L(GMTST2) "" S GMTSA=GMTST1 Q GMTSA
|
|---|
| 126 | Q
|
|---|
| 127 | TA(X) ; Time Limits Applicable S Y:yes 0;3
|
|---|
| 128 | N GMTSA S GMTSA=$P($G(^GMT(142.1,+($G(X)),0)),"^",3),X=$S(GMTSA="Y":1,1:0) Q X
|
|---|
| 129 | OA(X) ; Maximum Occurrences Applicable S Y:yes 0;5
|
|---|
| 130 | N GMTSA S GMTSA=$P($G(^GMT(142.1,+($G(X)),0)),"^",5),X=$S(GMTSA="Y":1,1:0) Q X
|
|---|
| 131 | TLL(X) ; Time Limits (Litteral)
|
|---|
| 132 | S X=$$UP($G(X))
|
|---|
| 133 | N GMTSU,GMTSQ S GMTSQ=+X,GMTSU=$E(X,$L(X)) Q:GMTSU="^"!(GMTSU="") "" Q:GMTSQ=0 ""
|
|---|
| 134 | Q:"^D^W^M^Y^"'[GMTSU "" S GMTSU=$S(GMTSU="D":" day",GMTSU="W":" week",GMTSU="M":" month",GMTSU="Y":" year",1:"") Q:'$L(GMTSU) ""
|
|---|
| 135 | S GMTSU=$S(+GMTSQ>1:(GMTSU_"s"),1:GMTSU) S X=+GMTSQ_GMTSU
|
|---|
| 136 | Q X
|
|---|
| 137 | OLL(X) ; Occurrence Limits (Litteral)
|
|---|
| 138 | S X=+($G(X)) Q:X=0 ""
|
|---|
| 139 | N GMTSU,GMTSQ S GMTSQ=+X,GMTSU=" occurrence",GMTSU=$S(+GMTSQ>1:(GMTSU_"s"),1:GMTSU) S X=+GMTSQ_GMTSU
|
|---|
| 140 | Q X
|
|---|
| 141 | ;
|
|---|
| 142 | ; Other
|
|---|
| 143 | ENV(X) ; Environment check
|
|---|
| 144 | ; DBIA 10086 call HOME^%ZIS
|
|---|
| 145 | D HOME^%ZIS
|
|---|
| 146 | ; DBIA 2056 call $$GET1^DIQ
|
|---|
| 147 | I '$L($$GET1^DIQ(200,+($G(DUZ)),.01)) D BM(" Invalid User (DUZ)"),M("") Q 0
|
|---|
| 148 | Q 1
|
|---|
| 149 | BM(X) ; Blank Line with Message
|
|---|
| 150 | ; DBIA 10141 call BMES^XPDUTL
|
|---|
| 151 | Q:$D(GMTSQT) D:$D(XPDNM) BMES^XPDUTL($G(X)) W:'$D(XPDNM) !!,$G(X) Q
|
|---|
| 152 | M(X) ; Message
|
|---|
| 153 | ; DBIA 10141 call MES^XPDUTL
|
|---|
| 154 | Q:$D(GMTSQT) D:$D(XPDNM) MES^XPDUTL($G(X)) W:'$D(XPDNM) !,$G(X) Q
|
|---|
| 155 | UP(X) ; Uppercase
|
|---|
| 156 | Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
|---|
