- 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")
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSXPD3 8535 printed Feb 18, 2025@23:27:18 Page 2
- 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")