GMTSXPD3 ; SLC/KER - Health Summary Dist (Index/ADH) ; 07/18/2000
;;2.7;Health Summary;**35,37**;Oct 20, 1995
Q
;
BUILD ; Rebuild AD Hoc Health Summary
; Set Variable GMTSQT for QUIET Rebuild
N GMTSENV,DIK,DA,X,Y,INCLUDE S GMTSENV=$$ENV Q:'GMTSENV S INCLUDE=0 D M(" "),RC,RT,RB
Q
BUILDQ ; Quiet Rebuild
N GMTSQT S GMTSQT="" D BUILD Q
;
TSK(X) ; Tasked Rebuild
; Returns 0 Not tasked
; -1 Currently running
; # Task Number
;
S X=0,ZTRTN="TSKB^GMTSXPD3",ZTDESC="Rebuilding AD Hoc Health Summary",ZTIO="",ZTDTH=$H
S:$D(^TMP("GMTSXPD3")) X=-1 Q:X<0 X
; DBIA 10063 call ^%ZTLOAD
I '$D(^TMP("GMTSXPD3")) S ^TMP("GMTSXPD3")="" D ^%ZTLOAD
S X=+($G(ZTSK))
; DBIA 10086 call HOME^%ZIS
D HOME^%ZIS K ZTSAVE,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK
Q X
TSKB S ^TMP("GMTSXPD3")="" S:$D(ZTQUEUED) ZTREQ="@" D BUILDQ K ^TMP("GMTSXPD3")
Q
TO(GMTSCOM,GMTSTIM,GMTSOCC) ; Update Ad Hoc default time and occurrences
N GMTSTAD,GMTSTAS,GMTSTAN,GMTSTNN,GMTSTOT,GMTSTOC,GMTSTOO,GMTSTAV
N GMTSTTA,GMTSTOA,GMTSTQN,GMTST1,GMTST2,GMTSTLL,GMTSOLL
S GMTSCOM=$G(GMTSCOM) Q:'$L(GMTSCOM) S GMTSTIM=$$UP($G(GMTSTIM)),GMTSTAD=$$A S:+GMTSTIM=0 GMTSTIM=""
S GMTSOCC=+($G(GMTSOCC)) S:GMTSOCC=0 GMTSOCC="" S GMTSCOM=$$R(GMTSCOM),GMTSTOC=$$C(GMTSCOM),GMTSTTA=0 S:GMTSCOM=GMTSTOC GMTSTTA=$$TA(GMTSCOM)
S GMTSTOA=0 S:GMTSCOM=GMTSTOC GMTSTOA=$$OA(GMTSCOM) S GMTSTOT=$$T(GMTSTIM),GMTSTOO=$$O(GMTSOCC)
S GMTSTAD=$$A,GMTSTAS=$$S(GMTSTAD,GMTSTOC),GMTSTAN=$$N(GMTSTAD,GMTSTAS),GMTSTAV=""
S:$L(GMTSTAN) GMTSTAV=@GMTSTAN S GMTSTNN=GMTSTAV,GMTSTQN="" S:$L(GMTSTNN,"^")>2&(GMTSTOO=GMTSOCC) $P(GMTSTNN,"^",3)=GMTSOCC
S:$L(GMTSOCC)&(GMTSTOO=GMTSOCC) $P(GMTSTNN,"^",3)=GMTSOCC S:$L(GMTSTNN,"^")>3&(GMTSTOT=GMTSTIM) $P(GMTSTNN,"^",4)=GMTSTIM
S:$L(GMTSTIM)&(GMTSTOT=GMTSTIM) $P(GMTSTNN,"^",4)=GMTSTIM S:'GMTSTTA&($L(GMTSTNN,"^")>3) GMTSTNN=$P(GMTSTNN,"^",1,3)
S:'GMTSTTA&($P(GMTSTNN,"^",3)="") GMTSTNN=$P(GMTSTNN,"^",1,2) S:'GMTSTOA&($L(GMTSTNN,"^")=3) GMTSTNN=$P(GMTSTNN,"^",1,2)
S:'GMTSTOA&($L(GMTSTNN,"^")>3) $P(GMTSTNN,"^",3)=""
S:+GMTSTAS>0&($D(^GMT(142,+($G(GMTSTAD)),1,+GMTSTAS,0))) $P(GMTSTQN,"^",1)=GMTSTAS
S:+GMTSTOC>0&(GMTSTOC=GMTSCOM)&($D(^GMT(142.1,+($G(GMTSTOC)),0))) $P(GMTSTQN,"^",2)=GMTSTOC
S:+GMTSTOA>0&($L(GMTSTOO)) $P(GMTSTQN,"^",3)=GMTSTOO,GMTSOCC=GMTSTOO
S:+GMTSTTA>0&($L(GMTSTOT)) $P(GMTSTQN,"^",4)=GMTSTOT,GMTSTIM=GMTSTOT
S:+GMTSTOA=0&($L(GMTSTOO)) GMTSTOO="" S:+GMTSTTA=0&($L(GMTSTOT)) GMTSTOT=""
Q:'$L(GMTSTAN) Q:'$L(GMTSTQN) Q:'$D(^GMT(142,+($G(GMTSTAD)),0)) Q:'$D(^GMT(142,+($G(GMTSTAD)),1,+($G(GMTSTAS)),0))
Q:GMTSTOT'=GMTSTIM Q:GMTSTOO'=GMTSOCC Q:GMTSCOM'=GMTSTOC Q:$P(GMTSTNN,"^",1,2)'=$P(GMTSTQN,"^",1,2)
S GMTSCOM=$P(GMTSTQN,"^",2),GMTSOCC=$P(GMTSTQN,"^",3),GMTSTIM=$P(GMTSTQN,"^",4)
Q:+GMTSCOM=0 S GMTSCOM=$P($G(^GMT(142.1,+GMTSCOM,0)),"^",1) Q:'$L(GMTSCOM)
S GMTST1=" Setting time and occurrence limits for GMTS HS ADHOC OPTION component" D BM(GMTST1)
S GMTSOLL=$$OLL(+GMTSOCC),GMTSTLL=$$TLL(GMTSTIM)
I $L(GMTSOLL),$L(GMTSTLL) D
. S GMTST1=" "_GMTSCOM_" (Limits - "_GMTSTLL_" and "_GMTSOLL_")" D M(GMTST1)
I '$L(GMTSOLL)!('$L(GMTSTLL)) D
. S GMTST1=" "_GMTSCOM D M(GMTST1)
. S GMTST1=$S($L($G(GMTSTIM))&($L($G(GMTSTLL))):" Limits: ",1:" Time Limits: ")
. 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))
. S GMTST1=$S($L($G(GMTSTIM))&($L($G(GMTSTLL))):" ",1:" Occurrence Limits: ")
. 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))
S @GMTSTAN=GMTSTQN
Q
;
; Indexing
RT ; Re-Index HS Type File
N GMTST,GMTSL,GMTSQ,GMTSC,GMTSE,DA,DIK,DIC,X,Y
S U="^",GMTSE=59,GMTST=" Re-Indexing Health Summary Type file "
S GMTSL=$L(GMTST),(GMTSC,DA)=0 F S DA=$O(^GMT(142,DA)) Q:+DA=0 S GMTSC=GMTSC+1
S GMTSC=GMTSC-1,GMTSQ=GMTSC\(GMTSE-$L(GMTST)) S:GMTSQ'>0 GMTSQ=1 D M(GMTST)
S DIK="^GMT(142,",(GMTSC,DA)=0 F S DA=$O(^GMT(142,DA)) Q:+DA=0 D
. ; DBIA 10013 call IX^DIK
. D IX^DIK Q:$D(GMTSQT)
. 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
RC ; Re-Index HS Component File
N GMTST,GMTSL,GMTSQ,GMTSC,GMTSE,DA,DIK,DIC,X,Y
S U="^",GMTSE=59,GMTST=" Re-Indexing Health Summary Component file ",GMTSL=$L(GMTST),(GMTSC,DA)=0
F S DA=$O(^GMT(142.1,DA)) Q:+DA=0 S GMTSC=GMTSC+1
S GMTSC=GMTSC-1,GMTSQ=GMTSC\(GMTSE-$L(GMTST)) S:GMTSQ'>0 GMTSQ=1 D M(GMTST)
S DIK="^GMT(142.1,",(GMTSC,DA)=0 F S DA=$O(^GMT(142.1,DA)) Q:+DA=0 D
. ; DBIA 10013 call IX^DIK
. D IX^DIK Q:$D(GMTSQT)
. 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
RA ; Re-Index HS Type "Ad Hoc"
; DBIA 10013 call IX1^DIK
N GMTST,DA,DIK S DIK="^GMT(142,",DA=$$A,U="^" Q:+DA=0 D IX1^DIK
Q
RB ; Re-Build Ad Hoc Health Summary Type
D RB^GMTSXPD4 Q
;
; Check Input
T(X) ; Time Input Transform
; DBIA 10104 call $$UP^XLFSTR
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
O(X) ; Occurrence Input Transform
S X=$G(X) S:+X'=X!(X>99999)!(X<1)!(X?.E1"."1N.N) X="10" Q X
C(X) ; Component Input Transform
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
R(X) ; Resolve Pointer
S X=$G(X) Q:'$L(X) "" N GMTSA S GMTSA=X I $D(^GMT(142.1,+X,0)) S X=+X Q X
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
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
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
Q ""
A(X) ; Ad Hoc IEN
S X=0 S X=+($O(^GMT(142,"AB","GMTS HS ADHOC OPTION",0))) Q:+X>0 +X
S X=+($O(^GMT(142,"B","GMTS HS ADHOC OPTION",0))) Q:+X>0 +X
S X=+($O(^GMT(142,"E","Ad Hoc Health Summary Type",0))) Q:+X>0 +X Q 0
S(GMTSA,GMTSC) ; Structure IEN
N GMTST1,GMTST2 S GMTSA=+($G(GMTSA)) Q:GMTSA=0 ""
S GMTSC=+($G(GMTSC)) Q:GMTSC=0 ""
Q:'$D(^GMT(142,GMTSA,1,"C",GMTSC)) ""
Q:'$D(^GMT(142,"AE",GMTSC,GMTSA)) ""
S GMTST1=+($O(^GMT(142,GMTSA,1,"C",GMTSC,0)))
S GMTST2=+($O(^GMT(142,"AE",GMTSC,GMTSA,0)))
Q:GMTST1'=GMTST2!(GMTST1=0)!(GMTST2=0) "" S GMTSA=GMTST1 Q GMTSA
N(GMTSA,GMTSC) ; Structure IEN
N GMTST1,GMTST2
S GMTSA=+($G(GMTSA)) Q:GMTSA=0 "" S GMTSC=+($G(GMTSC)) Q:GMTSC=0 ""
S GMTST1="^GMT(142,"_GMTSA_",1,"_GMTSC_",0)",GMTST2=$G(@GMTST1)
Q:'$D(@GMTST1) "" Q:'$L(GMTST2) "" S GMTSA=GMTST1 Q GMTSA
Q
TA(X) ; Time Limits Applicable S Y:yes 0;3
N GMTSA S GMTSA=$P($G(^GMT(142.1,+($G(X)),0)),"^",3),X=$S(GMTSA="Y":1,1:0) Q X
OA(X) ; Maximum Occurrences Applicable S Y:yes 0;5
N GMTSA S GMTSA=$P($G(^GMT(142.1,+($G(X)),0)),"^",5),X=$S(GMTSA="Y":1,1:0) Q X
TLL(X) ; Time Limits (Litteral)
S X=$$UP($G(X))
N GMTSU,GMTSQ S GMTSQ=+X,GMTSU=$E(X,$L(X)) Q:GMTSU="^"!(GMTSU="") "" Q:GMTSQ=0 ""
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) ""
S GMTSU=$S(+GMTSQ>1:(GMTSU_"s"),1:GMTSU) S X=+GMTSQ_GMTSU
Q X
OLL(X) ; Occurrence Limits (Litteral)
S X=+($G(X)) Q:X=0 ""
N GMTSU,GMTSQ S GMTSQ=+X,GMTSU=" occurrence",GMTSU=$S(+GMTSQ>1:(GMTSU_"s"),1:GMTSU) S X=+GMTSQ_GMTSU
Q X
;
; Other
ENV(X) ; Environment check
; DBIA 10086 call HOME^%ZIS
D HOME^%ZIS
; DBIA 2056 call $$GET1^DIQ
I '$L($$GET1^DIQ(200,+($G(DUZ)),.01)) D BM(" Invalid User (DUZ)"),M("") Q 0
Q 1
BM(X) ; Blank Line with Message
; DBIA 10141 call BMES^XPDUTL
Q:$D(GMTSQT) D:$D(XPDNM) BMES^XPDUTL($G(X)) W:'$D(XPDNM) !!,$G(X) Q
M(X) ; Message
; DBIA 10141 call MES^XPDUTL
Q:$D(GMTSQT) D:$D(XPDNM) MES^XPDUTL($G(X)) W:'$D(XPDNM) !,$G(X) Q
UP(X) ; Uppercase
Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
GMTSXPD3 ; SLC/KER - Health Summary Dist (Index/ADH) ; 07/18/2000
+1 ;;2.7;Health Summary;**35,37**;Oct 20, 1995
+2 QUIT
+3 ;
BUILD ; Rebuild AD Hoc Health Summary
+1 ; Set Variable GMTSQT for QUIET Rebuild
+2 NEW GMTSENV,DIK,DA,X,Y,INCLUDE
SET GMTSENV=$$ENV
IF 'GMTSENV
QUIT
SET INCLUDE=0
DO M(" ")
DO RC
DO RT
DO RB
+3 QUIT
BUILDQ ; Quiet Rebuild
+1 NEW GMTSQT
SET GMTSQT=""
DO BUILD
QUIT
+2 ;
TSK(X) ; Tasked Rebuild
+1 ; Returns 0 Not tasked
+2 ; -1 Currently running
+3 ; # Task Number
+4 ;
+5 SET X=0
SET ZTRTN="TSKB^GMTSXPD3"
SET ZTDESC="Rebuilding AD Hoc Health Summary"
SET ZTIO=""
SET ZTDTH=$HOROLOG
+6 IF $DATA(^TMP("GMTSXPD3"))
SET X=-1
IF X<0
QUIT X
+7 ; DBIA 10063 call ^%ZTLOAD
+8 IF '$DATA(^TMP("GMTSXPD3"))
SET ^TMP("GMTSXPD3")=""
DO ^%ZTLOAD
+9 SET X=+($GET(ZTSK))
+10 ; DBIA 10086 call HOME^%ZIS
+11 DO HOME^%ZIS
KILL ZTSAVE,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK
+12 QUIT X
TSKB SET ^TMP("GMTSXPD3")=""
IF $DATA(ZTQUEUED)
SET ZTREQ="@"
DO BUILDQ
KILL ^TMP("GMTSXPD3")
+1 QUIT
TO(GMTSCOM,GMTSTIM,GMTSOCC) ; Update Ad Hoc default time and occurrences
+1 NEW GMTSTAD,GMTSTAS,GMTSTAN,GMTSTNN,GMTSTOT,GMTSTOC,GMTSTOO,GMTSTAV
+2 NEW GMTSTTA,GMTSTOA,GMTSTQN,GMTST1,GMTST2,GMTSTLL,GMTSOLL
+3 SET GMTSCOM=$GET(GMTSCOM)
IF '$LENGTH(GMTSCOM)
QUIT
SET GMTSTIM=$$UP($GET(GMTSTIM))
SET GMTSTAD=$$A
IF +GMTSTIM=0
SET GMTSTIM=""
+4 SET GMTSOCC=+($GET(GMTSOCC))
IF GMTSOCC=0
SET GMTSOCC=""
SET GMTSCOM=$$R(GMTSCOM)
SET GMTSTOC=$$C(GMTSCOM)
SET GMTSTTA=0
IF GMTSCOM=GMTSTOC
SET GMTSTTA=$$TA(GMTSCOM)
+5 SET GMTSTOA=0
IF GMTSCOM=GMTSTOC
SET GMTSTOA=$$OA(GMTSCOM)
SET GMTSTOT=$$T(GMTSTIM)
SET GMTSTOO=$$O(GMTSOCC)
+6 SET GMTSTAD=$$A
SET GMTSTAS=$$S(GMTSTAD,GMTSTOC)
SET GMTSTAN=$$N(GMTSTAD,GMTSTAS)
SET GMTSTAV=""
+7 IF $LENGTH(GMTSTAN)
SET GMTSTAV=@GMTSTAN
SET GMTSTNN=GMTSTAV
SET GMTSTQN=""
IF $LENGTH(GMTSTNN,"^")>2&(GMTSTOO=GMTSOCC)
SET $PIECE(GMTSTNN,"^",3)=GMTSOCC
+8 IF $LENGTH(GMTSOCC)&(GMTSTOO=GMTSOCC)
SET $PIECE(GMTSTNN,"^",3)=GMTSOCC
IF $LENGTH(GMTSTNN,"^")>3&(GMTSTOT=GMTSTIM)
SET $PIECE(GMTSTNN,"^",4)=GMTSTIM
+9 IF $LENGTH(GMTSTIM)&(GMTSTOT=GMTSTIM)
SET $PIECE(GMTSTNN,"^",4)=GMTSTIM
IF 'GMTSTTA&($LENGTH(GMTSTNN,"^")>3)
SET GMTSTNN=$PIECE(GMTSTNN,"^",1,3)
+10 IF 'GMTSTTA&($PIECE(GMTSTNN,"^",3)="")
SET GMTSTNN=$PIECE(GMTSTNN,"^",1,2)
IF 'GMTSTOA&($LENGTH(GMTSTNN,"^")=3)
SET GMTSTNN=$PIECE(GMTSTNN,"^",1,2)
+11 IF 'GMTSTOA&($LENGTH(GMTSTNN,"^")>3)
SET $PIECE(GMTSTNN,"^",3)=""
+12 IF +GMTSTAS>0&($DATA(^GMT(142,+($GET(GMTSTAD)),1,+GMTSTAS,0)))
SET $PIECE(GMTSTQN,"^",1)=GMTSTAS
+13 IF +GMTSTOC>0&(GMTSTOC=GMTSCOM)&($DATA(^GMT(142.1,+($GET(GMTSTOC)),0)))
SET $PIECE(GMTSTQN,"^",2)=GMTSTOC
+14 IF +GMTSTOA>0&($LENGTH(GMTSTOO))
SET $PIECE(GMTSTQN,"^",3)=GMTSTOO
SET GMTSOCC=GMTSTOO
+15 IF +GMTSTTA>0&($LENGTH(GMTSTOT))
SET $PIECE(GMTSTQN,"^",4)=GMTSTOT
SET GMTSTIM=GMTSTOT
+16 IF +GMTSTOA=0&($LENGTH(GMTSTOO))
SET GMTSTOO=""
IF +GMTSTTA=0&($LENGTH(GMTSTOT))
SET GMTSTOT=""
+17 IF '$LENGTH(GMTSTAN)
QUIT
IF '$LENGTH(GMTSTQN)
QUIT
IF '$DATA(^GMT(142,+($GET(GMTSTAD)),0))
QUIT
IF '$DATA(^GMT(142,+($GET(GMTSTAD)),1,+($GET(GMTSTAS)),0))
QUIT
+18 IF GMTSTOT'=GMTSTIM
QUIT
IF GMTSTOO'=GMTSOCC
QUIT
IF GMTSCOM'=GMTSTOC
QUIT
IF $PIECE(GMTSTNN,"^",1,2)'=$PIECE(GMTSTQN,"^",1,2)
QUIT
+19 SET GMTSCOM=$PIECE(GMTSTQN,"^",2)
SET GMTSOCC=$PIECE(GMTSTQN,"^",3)
SET GMTSTIM=$PIECE(GMTSTQN,"^",4)
+20 IF +GMTSCOM=0
QUIT
SET GMTSCOM=$PIECE($GET(^GMT(142.1,+GMTSCOM,0)),"^",1)
IF '$LENGTH(GMTSCOM)
QUIT
+21 SET GMTST1=" Setting time and occurrence limits for GMTS HS ADHOC OPTION component"
DO BM(GMTST1)
+22 SET GMTSOLL=$$OLL(+GMTSOCC)
SET GMTSTLL=$$TLL(GMTSTIM)
+23 IF $LENGTH(GMTSOLL)
IF $LENGTH(GMTSTLL)
Begin DoDot:1
+24 SET GMTST1=" "_GMTSCOM_" (Limits - "_GMTSTLL_" and "_GMTSOLL_")"
DO M(GMTST1)
End DoDot:1
+25 IF '$LENGTH(GMTSOLL)!('$LENGTH(GMTSTLL))
Begin DoDot:1
+26 SET GMTST1=" "_GMTSCOM
DO M(GMTST1)
+27 SET GMTST1=$SELECT($LENGTH($GET(GMTSTIM))&($LENGTH($GET(GMTSTLL))):" Limits: ",1:" Time Limits: ")
+28 SET GMTST2=$SELECT($LENGTH($GET(GMTSTIM))&('$LENGTH($GET(GMTSTLL))):GMTSTIM,$LENGTH($GET(GMTSTIM))&($LENGTH($GET(GMTSTLL))):GMTSTLL,1:"No time limit <null>")
DO M((GMTST1_GMTST2))
+29 SET GMTST1=$SELECT($LENGTH($GET(GMTSTIM))&($LENGTH($GET(GMTSTLL))):" ",1:" Occurrence Limits: ")
+30 SET GMTST2=$SELECT($LENGTH($GET(GMTSOCC))&('$LENGTH($GET(GMTSOLL))):GMTSOCC,$LENGTH($GET(GMTSOCC))&($LENGTH($GET(GMTSOLL))):GMTSOLL,1:"No occurrence limit <null>")
DO M((GMTST1_GMTST2))
End DoDot:1
+31 SET @GMTSTAN=GMTSTQN
+32 QUIT
+33 ;
+34 ; Indexing
RT ; Re-Index HS Type File
+1 NEW GMTST,GMTSL,GMTSQ,GMTSC,GMTSE,DA,DIK,DIC,X,Y
+2 SET U="^"
SET GMTSE=59
SET GMTST=" Re-Indexing Health Summary Type file "
+3 SET GMTSL=$LENGTH(GMTST)
SET (GMTSC,DA)=0
FOR
SET DA=$ORDER(^GMT(142,DA))
IF +DA=0
QUIT
SET GMTSC=GMTSC+1
+4 SET GMTSC=GMTSC-1
SET GMTSQ=GMTSC\(GMTSE-$LENGTH(GMTST))
IF GMTSQ'>0
SET GMTSQ=1
DO M(GMTST)
+5 SET DIK="^GMT(142,"
SET (GMTSC,DA)=0
FOR
SET DA=$ORDER(^GMT(142,DA))
IF +DA=0
QUIT
Begin DoDot:1
+6 ; DBIA 10013 call IX^DIK
+7 DO IX^DIK
IF $DATA(GMTSQT)
QUIT
+8 SET GMTSC=GMTSC+1
IF GMTSC#GMTSQ=0
SET GMTSL=GMTSL+1
IF GMTSL>GMTSE
QUIT
+9 IF GMTSC#GMTSQ=0
WRITE "."
End DoDot:1
+10 IF '$DATA(GMTSQT)
IF GMTSL'>GMTSE
FOR
SET GMTSL=GMTSL+1
IF GMTSL>GMTSE
QUIT
WRITE "."
+11 IF '$DATA(GMTSQT)
WRITE ?GMTSE," < done >"
+12 QUIT
RC ; Re-Index HS Component File
+1 NEW GMTST,GMTSL,GMTSQ,GMTSC,GMTSE,DA,DIK,DIC,X,Y
+2 SET U="^"
SET GMTSE=59
SET GMTST=" Re-Indexing Health Summary Component file "
SET GMTSL=$LENGTH(GMTST)
SET (GMTSC,DA)=0
+3 FOR
SET DA=$ORDER(^GMT(142.1,DA))
IF +DA=0
QUIT
SET GMTSC=GMTSC+1
+4 SET GMTSC=GMTSC-1
SET GMTSQ=GMTSC\(GMTSE-$LENGTH(GMTST))
IF GMTSQ'>0
SET GMTSQ=1
DO M(GMTST)
+5 SET DIK="^GMT(142.1,"
SET (GMTSC,DA)=0
FOR
SET DA=$ORDER(^GMT(142.1,DA))
IF +DA=0
QUIT
Begin DoDot:1
+6 ; DBIA 10013 call IX^DIK
+7 DO IX^DIK
IF $DATA(GMTSQT)
QUIT
+8 SET GMTSC=GMTSC+1
IF GMTSC#GMTSQ=0
SET GMTSL=GMTSL+1
IF GMTSL>GMTSE
QUIT
+9 IF GMTSC#GMTSQ=0
WRITE "."
End DoDot:1
+10 IF '$DATA(GMTSQT)
IF GMTSL'>GMTSE
FOR
SET GMTSL=GMTSL+1
IF GMTSL>GMTSE
QUIT
WRITE "."
+11 IF '$DATA(GMTSQT)
WRITE ?GMTSE," < done >"
+12 QUIT
RA ; Re-Index HS Type "Ad Hoc"
+1 ; DBIA 10013 call IX1^DIK
+2 NEW GMTST,DA,DIK
SET DIK="^GMT(142,"
SET DA=$$A
SET U="^"
IF +DA=0
QUIT
DO IX1^DIK
+3 QUIT
RB ; Re-Build Ad Hoc Health Summary Type
+1 DO RB^GMTSXPD4
QUIT
+2 ;
+3 ; Check Input
T(X) ; Time Input Transform
+1 ; DBIA 10104 call $$UP^XLFSTR
+2 SET X=$$UP^XLFSTR($GET(X))
IF $LENGTH(X)>5!($LENGTH(X)<1)!'((X?1N.N1U)!(X?1N.N1"D")!(X?1N.N1"W")!(X?1N.N1"M")!(X?1N.N1"Y"))
SET X="1Y"
QUIT X
O(X) ; Occurrence Input Transform
+1 SET X=$GET(X)
IF +X'=X!(X>99999)!(X<1)!(X?.E1"."1N.N)
SET X="10"
QUIT X
C(X) ; Component Input Transform
+1 SET X=$GET(X)
IF '$LENGTH(X)
QUIT "Error"
IF +X'>0
QUIT "Error"
IF '$DATA(^GMT(142.1,+X,0))
QUIT "Error"
SET X=+X
QUIT X
R(X) ; Resolve Pointer
+1 SET X=$GET(X)
IF '$LENGTH(X)
QUIT ""
NEW GMTSA
SET GMTSA=X
IF $DATA(^GMT(142.1,+X,0))
SET X=+X
QUIT X
+2 IF $DATA(^GMT(142.1,"B",X))
SET GMTSA=+($ORDER(^GMT(142.1,"B",X,0)))
IF GMTSA=X&($DATA(^GMT(142.1,"B",$$UP(X))))
SET GMTSA=+($ORDER(^GMT(142.1,"B",$$UP(X),0)))
IF GMTSA'=X
SET X=GMTSA
QUIT X
+3 IF GMTSA=X&($DATA(^GMT(142.1,"C",X)))
SET GMTSA=+($ORDER(^GMT(142.1,"C",X,0)))
IF GMTSA=X&($DATA(^GMT(142.1,"C",$$UP(X))))
SET GMTSA=+($ORDER(^GMT(142.1,"C",$$UP(X),0)))
IF GMTSA'=X
SET X=GMTSA
QUIT X
+4 IF GMTSA=X&($DATA(^GMT(142.1,"D",X)))
SET GMTSA=+($ORDER(^GMT(142.1,"D",X,0)))
IF GMTSA=X&($DATA(^GMT(142.1,"D",$$UP(X))))
SET GMTSA=+($ORDER(^GMT(142.1,"D",$$UP(X),0)))
IF GMTSA'=X
SET X=GMTSA
QUIT X
+5 QUIT ""
A(X) ; Ad Hoc IEN
+1 SET X=0
SET X=+($ORDER(^GMT(142,"AB","GMTS HS ADHOC OPTION",0)))
IF +X>0
QUIT +X
+2 SET X=+($ORDER(^GMT(142,"B","GMTS HS ADHOC OPTION",0)))
IF +X>0
QUIT +X
+3 SET X=+($ORDER(^GMT(142,"E","Ad Hoc Health Summary Type",0)))
IF +X>0
QUIT +X
QUIT 0
S(GMTSA,GMTSC) ; Structure IEN
+1 NEW GMTST1,GMTST2
SET GMTSA=+($GET(GMTSA))
IF GMTSA=0
QUIT ""
+2 SET GMTSC=+($GET(GMTSC))
IF GMTSC=0
QUIT ""
+3 IF '$DATA(^GMT(142,GMTSA,1,"C",GMTSC))
QUIT ""
+4 IF '$DATA(^GMT(142,"AE",GMTSC,GMTSA))
QUIT ""
+5 SET GMTST1=+($ORDER(^GMT(142,GMTSA,1,"C",GMTSC,0)))
+6 SET GMTST2=+($ORDER(^GMT(142,"AE",GMTSC,GMTSA,0)))
+7 IF GMTST1'=GMTST2!(GMTST1=0)!(GMTST2=0)
QUIT ""
SET GMTSA=GMTST1
QUIT GMTSA
N(GMTSA,GMTSC) ; Structure IEN
+1 NEW GMTST1,GMTST2
+2 SET GMTSA=+($GET(GMTSA))
IF GMTSA=0
QUIT ""
SET GMTSC=+($GET(GMTSC))
IF GMTSC=0
QUIT ""
+3 SET GMTST1="^GMT(142,"_GMTSA_",1,"_GMTSC_",0)"
SET GMTST2=$GET(@GMTST1)
+4 IF '$DATA(@GMTST1)
QUIT ""
IF '$LENGTH(GMTST2)
QUIT ""
SET GMTSA=GMTST1
QUIT GMTSA
+5 QUIT
TA(X) ; Time Limits Applicable S Y:yes 0;3
+1 NEW GMTSA
SET GMTSA=$PIECE($GET(^GMT(142.1,+($GET(X)),0)),"^",3)
SET X=$SELECT(GMTSA="Y":1,1:0)
QUIT X
OA(X) ; Maximum Occurrences Applicable S Y:yes 0;5
+1 NEW GMTSA
SET GMTSA=$PIECE($GET(^GMT(142.1,+($GET(X)),0)),"^",5)
SET X=$SELECT(GMTSA="Y":1,1:0)
QUIT X
TLL(X) ; Time Limits (Litteral)
+1 SET X=$$UP($GET(X))
+2 NEW GMTSU,GMTSQ
SET GMTSQ=+X
SET GMTSU=$EXTRACT(X,$LENGTH(X))
IF GMTSU="^"!(GMTSU="")
QUIT ""
IF GMTSQ=0
QUIT ""
+3 IF "^D^W^M^Y^"'[GMTSU
QUIT ""
SET GMTSU=$SELECT(GMTSU="D":" day",GMTSU="W":" week",GMTSU="M":" month",GMTSU="Y":" year",1:"")
IF '$LENGTH(GMTSU)
QUIT ""
+4 SET GMTSU=$SELECT(+GMTSQ>1:(GMTSU_"s"),1:GMTSU)
SET X=+GMTSQ_GMTSU
+5 QUIT X
OLL(X) ; Occurrence Limits (Litteral)
+1 SET X=+($GET(X))
IF X=0
QUIT ""
+2 NEW GMTSU,GMTSQ
SET GMTSQ=+X
SET GMTSU=" occurrence"
SET GMTSU=$SELECT(+GMTSQ>1:(GMTSU_"s"),1:GMTSU)
SET X=+GMTSQ_GMTSU
+3 QUIT X
+4 ;
+5 ; Other
ENV(X) ; Environment check
+1 ; DBIA 10086 call HOME^%ZIS
+2 DO HOME^%ZIS
+3 ; DBIA 2056 call $$GET1^DIQ
+4 IF '$LENGTH($$GET1^DIQ(200,+($GET(DUZ)),.01))
DO BM(" Invalid User (DUZ)")
DO M("")
QUIT 0
+5 QUIT 1
BM(X) ; Blank Line with Message
+1 ; DBIA 10141 call BMES^XPDUTL
+2 IF $DATA(GMTSQT)
QUIT
IF $DATA(XPDNM)
DO BMES^XPDUTL($GET(X))
IF '$DATA(XPDNM)
WRITE !!,$GET(X)
QUIT
M(X) ; Message
+1 ; DBIA 10141 call MES^XPDUTL
+2 IF $DATA(GMTSQT)
QUIT
IF $DATA(XPDNM)
DO MES^XPDUTL($GET(X))
IF '$DATA(XPDNM)
WRITE !,$GET(X)
QUIT
UP(X) ; Uppercase
+1 QUIT $TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
