Changeset 623 for WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSUP.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSUP.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSUP.m
r613 r623 1 GMTSUP ; SLC/KER - Utilities for Paging HS ; 01/06/2003 2 ;;2.7;Health Summary;**2,7,21,27,28,30,35,47,56,58,85**;Oct 20, 1995;Build 24 3 ; 4 ; External References 5 ; DBIA 10026 ^DIR 6 ; DBIA 82 EN^XQORM 7 ; 8 CKP ; Check page position, pause and prompt 9 Q:$D(GMTSQIT) S GMTSNPG=0 10 K:$L($G(GMTSOBJ("LABEL"))) GMTSOBJ("REPORT HEADER") 11 I $G(GMTSWRIT)=1 D BREAK S GMTSWRIT=0 12 I +($$HF^GMTSU) D BREAK:(GMTSEGN'=$G(GMTSLCMP)) Q 13 Q:+$G(GMTSLPG)'>0&($Y'>(IOSL-GMTSLO)) 14 I $E(IOST,1)="C" S:'$D(GMTSTOF) GMTSTOF=1 D CKP1 15 I '$D(GMTSQIT) W @IOF D HEADER,BREAK S GMTSNPG=1,GMTSTOF=GMTSEGN 16 I $D(GMTSQIT),(GMTSQIT]""),($D(GMTSTYP)) W @IOF D HEADER S GMTSTOF=GMTSEGN 17 Q 18 CKP1 ; Help Display of Optional Components for Navigation 19 N DA,I,J,K,L,X,XQORM,Y,GMTSY,TYP,DIC 20 I $S('$D(GMTSTYP):1,$D(GMTOPT):1,1:0) N DIR S DIR(0)="E" D ^DIR K DIR S:$D(DUOUT)!(GMTSLPG) GMTSQIT="" Q 21 S TYP=GMTSTYP 22 S DIC=142,DIC(0)="MZF",X="GMTS HS ADHOC OPTION" S Y=$$TYPE^GMTSULT 23 S GMTSTYP=+Y K DIC,X,Y 24 S XQORM=GMTSTYP_";GMT(142,",XQORM(0)="1AF\+",XQORM("A")="Press <RET> to continue, ^ to exit, or select component: " 25 S XQORM("??")="D HELP^GMTSUP1" I GMTSLPG,'$D(GMTSOBJ) W:'$D(GMTSOBJE) "* END * " 26 S XQORM("S")="I $D(^GMT(142,DA(1),1,DA,0)),($P(^GMT(142.1,$P(^GMT(142,DA(1),1,DA,0),U,2),0),U,6)'=""T"")" 27 D EN^XQORM W ! D @$S(Y=1:"BRNCH",1:"EVAL") 28 I $D(GMTSY),(GMTSY=0) K GMTSY G CKP1 29 S GMTSTYP=TYP 30 Q 31 BREAK ; Writes the Component Header 32 ; 33 ; If the variable GMTSOBJ exist, then the 34 ; Component Headers are suppressed with the 35 ; following exceptions: 36 ; 37 ; If GMTSOBJ("COMPONENT HEADER") exist, 38 ; then the Component Header will NOT be 39 ; suppressed 40 ; 41 ; If GMTSOBJ("BLANK LINE") exist, a blank 42 ; line will be written after the Component 43 ; Header 44 ; 45 N GMTSM,GMTSF S GMTSM=$$MUL,GMTSF=$$FST 46 I +GMTSM=0,$D(GMTSOBJ),'$D(GMTSOBJ("COMPONENT HEADER")),'$D(GMTSOBJ("BLANK LINE")) Q 47 N GMTS,GMTSUL,GMTSL S:'$D(GMTSLCMP) GMTSLCMP=0 48 S GMTSUL="",GMTSNPG=1,GMTS=$$CHDR,GMTSL=+($L($G(GMTS))),$P(GMTSUL,"-",+GMTSL)="-" 49 I $Y'>(IOSL-GMTSLO)!(+($$HF^GMTSU)) D 50 . I $D(GMTSOBJ) D Q 51 . . S GMTSLCMP=GMTSEGN 52 . . I +($G(GMTSM))>0!($D(GMTSOBJ("COMPONENT HEADER"))) D 53 . . . W:+GMTSF=0 ! W !,GMTS W:$D(GMTSOBJ("UNDERLINE")) !,GMTSUL 54 . . . W ! W:$D(GMTSOBJ("BLANK LINE")) ! 55 . W !,GMTS,! 56 . W:$Y'>(IOSL-GMTSLO) ?34,$S(GMTSEGN=GMTSLCMP:"(continued)",1:""),! 57 . S GMTSLCMP=GMTSEGN 58 Q 59 OLDB ; 60 S:'$D(GMTSLCMP) GMTSLCMP=0 61 S GMTS="",GMTSNPG=1 62 S $P(GMTS,"-",79-$L(GMTSEGH_GMTSEGL)/2)="" 63 S GMTS=GMTS_" "_GMTSEGH_GMTSEGL_" "_GMTS 64 I $Y'>(IOSL-GMTSLO)!(+($$HF^GMTSU)) D 65 . W !,GMTS,! 66 . W:$Y'>(IOSL-GMTSLO) ?34,$S(GMTSEGN=GMTSLCMP:"(continued)",1:""),! 67 . S GMTSLCMP=GMTSEGN 68 Q 69 HEADER ; Print Running Header 70 ; 71 ; If the variable GMTSOBJ exist, then the 72 ; Report Headers are suppressed with the 73 ; following exceptions: 74 ; 75 ; If GMTSOBJ("DATE LINE") exist, then the 76 ; Location/Report Date line will NOT be 77 ; suppressed. 78 ; 79 ; If GMTSOBJ("CONFIDENTIAL") exist, then 80 ; the Confidential Header Name line will 81 ; NOT be suppressed. 82 ; 83 ; If GMTSOBJ("REPORT HEADER") exist, then 84 ; the Report Header containing the patient's 85 ; name, SSAN, ward and DOB will NOT be 86 ; suppressed. 87 ; 88 ; If the variable GMTSOBJ("LABEL") contains 89 ; text, and the variable GMTSOBJ("USE LABEL") 90 ; exist, then this text will be printed before 91 ; the object text. 92 ; 93 ; If GMTSOBJ("REPORT DECEASED") exist, then 94 ; the optional line that displays for Deceased 95 ; patients will NOT be suppressed. 96 ; 97 ; Header Lines: 98 N GMTSVDT,DATA S DATA="" I +$G(GMTSPXD1)&+$G(GMTSPXD2) D 99 . Q:$G(GMTSOBJ) S:'$D(GMTSOBJE) DATA="Printed for data " S:$D(GMTSOBJE) DATA="Include data " 100 . I GMTSPXD1=GMTSPXD2 S DATA=DATA_"on "_GMTSPXD1 Q 101 . S DATA=DATA_"from "_GMTSPXD2_" to "_GMTSPXD1 102 I $D(GMTSCDT(0)),'$D(GMTSOBJ) S GMTSVDT=GMTSCDT(0) S:GMTSDTM'["Printed:" GMTSDTM="Printed: "_GMTSDTM 103 ; Location and Date of Report 104 I '$D(GMTSOBJ)!($D(GMTSOBJ("DATE LINE"))) D 105 . N GMTSLOC S GMTSLOC=$S('$D(GMTSOBJ("DATE LINE")):$P($G(GMTSSC),U,2),1:"") 106 . W !,$S($L(GMTSLOC):"Location: "_GMTSLOC_" ",1:"") 107 . W $S($D(GMTSVDT):GMTSVDT,1:"") 108 . W:'$D(GMTSOBJ("DATE LINE")) DATA,?(79-$L(GMTSDTM)),GMTSDTM 109 . W:$D(GMTSOBJ("DATE LINE")) DATA,?(74-$L(GMTSDTM)),GMTSDTM 110 ; Confidential Header Name 111 S:'$D(GMTSPG) GMTSPG=0 112 S GMTSPG=GMTSPG+1,GMTSHDR=" CONFIDENTIAL "_GMTSTITL_" SUMMARY " 113 S GMTSHDR=GMTSHDR_$S($E(IOST,1)="C":"",1:" pg. "_GMTSPG) 114 S GMTS="" S:'$D(GMTSOBJ) $P(GMTS,"*",(77-$L(GMTSHDR))\2)="*" 115 S:$D(GMTSOBJ) $P(GMTS,"*",(72-$L(GMTSHDR))\2)="*" 116 S GMTSHDR=GMTS_" "_GMTSHDR_" "_GMTS 117 I '$D(GMTSOBJ)!($D(GMTSOBJ("CONFIDENTIAL"))) W !,GMTSHDR,"*" 118 ; Name, SSAN, Ward, DOB 119 I '$D(GMTSLFG) D 120 .I $G(GMTSTITL)'["AD HOC",($G(GMTSTITL)'["PDX"),($G(HSTAG)="") D EN^GMTSHCPR ;GMTS,85 restrict ssn/dob on HS Type hard copies 121 . I $G(GMTSPHDR("TWO")) D 122 . . I $D(GMTSOBJ),'$D(GMTSOBJ("REPORT HEADER")),$L($G(GMTSOBJ("LABEL"))) D LABEL 123 . . I $D(GMTSOBJ),'$D(GMTSOBJ("REPORT HEADER")) Q 124 . . W !,GMTSPHDR("NMSSN"),?GMTSPHDR("DOBS"),GMTSPHDR("DOB") 125 . . W !,?GMTSPHDR("WARDRBS"),GMTSPHDR("WARDRB") 126 . E D 127 . . I $D(GMTSOBJ),'$D(GMTSOBJ("REPORT HEADER")),$L($G(GMTSOBJ("LABEL"))) D LABEL 128 . . I $D(GMTSOBJ),'$D(GMTSOBJ("REPORT HEADER")) Q 129 . . W !,GMTSPHDR("NMSSN"),?GMTSPHDR("WARDRBS") 130 . . W GMTSPHDR("WARDRB"),?GMTSPHDR("DOBS"),GMTSPHDR("DOB") 131 ; Deceased 132 ; 133 I '$D(GMTSOBJ)!($D(GMTSOBJ("DECEASED"))) D 134 . W:+$G(VADM(6)) !,?26,"** DECEASED "_$P(VADM(6),U,2)_" **" 135 W:'$D(GMTSOBJ) ! 136 Q 137 BRNCH ; Checks abbreviation to branch to a different component 138 N GMTINX,LIM,CREC,SBS 139 I Y,("+-"[X) S:X="-" GMTSEGN=GMTSTOF-1 S (GMTSY,GMTSQIT)=1,GMTSLPG=0 Q 140 I X="^^" S DIROUT=1,GMTSQIT="" Q 141 I Y,(X?1"^^".E) Q 142 S GMTINX=$S($D(^GMT(142,GMTSTYP,1,+Y(1),0)):$P(^(0),U,2),1:"") 143 I 'GMTINX S GMTSY=0 Q 144 I '$D(GMTSEGI(GMTINX)) N GMI,GMJ,GMTSDFLT S GMI=1,GMJ=GMTSEGC,GMTSDFLT=1 D LOAD^GMTSADH S GMTSEGC=GMTSEGC+1 145 I '$D(GMTSEGI(GMTINX)) S GMTINX="",GMTSY=0 Q 146 S LIM=$P(Y(1),U,4) I LIM'["=" G NOLIM 147 S CREC=^GMT(142.1,GMTINX,0),SBS=GMTSEGI(GMTINX) D CMPLIM^GMTSADH2 148 I $D(DIROUT) S GMTSQIT="" Q 149 NOLIM ; No limits 150 S GMTSEGN=GMTSEGI(GMTINX)-1,(GMTSY,GMTSQIT)=1,GMTSLPG=0 151 Q 152 ; 153 EVAL ; Evaluate input to determine quit or continue 154 Q:'$D(X) 155 S:$D(GMTSEXIT) GMTSEXIT=$G(X) 156 S:$D(DTOUT) DIROUT=1 I $S(X="^^":1,GMTSLPG:1,$D(DIROUT):1,X="^":1,1:0) S GMTSQIT="" 157 I +$G(GMPSAP),(X="^") S GMDUOUT=1 158 Q 159 MUL(X) ; Multiple Components in Type 160 N GMTSF,GMTSL S GMTSF=$O(GMTSEG(0)),GMTSL=$O(GMTSEG(" "),-1) 161 Q:+GMTSF=+GMTSL 0 Q 1 162 FST(X) ; First Component in Type 163 N GMTSF,GMTSL S GMTSF=$O(GMTSEG(0)),GMTSL=+($G(GMTSEGN)) 164 Q:+GMTSF=+GMTSL 1 Q 0 165 CHDR(X) ; Component Header 166 N GMTSN,GMTSH,GMTSL,GMTS S GMTSN=$$CNAM,GMTSH=$G(GMTSEGH) 167 S GMTSL=$G(GMTSEGL),GMTS="",$P(GMTS,"-",79-$L(GMTSH_GMTSL)/2)="" 168 S X=GMTS_" "_GMTSH_GMTSL_" "_GMTS Q:'$D(GMTSOBJ) X 169 S:$L(GMTSH)&($D(GMTSOBJ("COMPONENT HEADER"))) GMTSN=GMTSH 170 S:$L(GMTSL)&($L(GMTSN))&($D(GMTSOBJ("LIMITS"))) GMTSN=GMTSN_" "_GMTSL 171 S X=GMTSN Q X 172 CNAM(X) ; Component Name 173 N GMTSH S GMTSH=+($P($G(GMTSEG(+($G(GMTSEGN)))),"^",2)) 174 S X=$P($G(^GMT(142.1,+GMTSH,0)),"^",1) Q X 175 LABEL ; Label 176 Q:'$D(GMTSOBJ("USE LABEL")) N LABEL S LABEL=$G(GMTSOBJ("LABEL")) 177 W !,LABEL W:$L(LABEL) ! W:$D(GMTSOBJ("LABEL BLANK LINE")) ! 178 Q 179 LABDAT ; Label/Date 180 Q:'$D(GMTSOBJ("USE LABEL")) N LABEL S LABEL=$G(GMTSOBJ("LABEL")) 181 I '$D(GMTSOBJ("DATE LINE")),$D(GMTSOBJ("LABEL")),$L(LABEL),$L($G(GMTSDTM)) S LABEL=LABEL_$J("",((79-$L(GMTSDTM))-$L(LABEL)))_GMTSDTM 182 I '$D(GMTSOBJ("DATE LINE")),$D(GMTSOBJ("LABEL")),'$L(LABEL),$L($G(GMTSDTM)) S LABEL="Information as of "_$G(GMTSDTM) 183 W !,LABEL W:$L(LABEL) ! W:$D(GMTSOBJ("LABEL BLANK LINE")) ! 184 Q 1 GMTSUP ; SLC/KER - Utilities for Paging HS ; 01/06/2003 2 ;;2.7;Health Summary;**2,7,21,27,28,30,35,47,56,58**;Oct 20, 1995 3 ; 4 ; External References 5 ; DBIA 10026 ^DIR 6 ; DBIA 82 EN^XQORM 7 ; 8 CKP ; Check page position, pause and prompt 9 Q:$D(GMTSQIT) S GMTSNPG=0 10 K:$L($G(GMTSOBJ("LABEL"))) GMTSOBJ("REPORT HEADER") 11 I $G(GMTSWRIT)=1 D BREAK S GMTSWRIT=0 12 I +($$HF^GMTSU) D BREAK:(GMTSEGN'=$G(GMTSLCMP)) Q 13 Q:+$G(GMTSLPG)'>0&($Y'>(IOSL-GMTSLO)) 14 I $E(IOST,1)="C" S:'$D(GMTSTOF) GMTSTOF=1 D CKP1 15 I '$D(GMTSQIT) W @IOF D HEADER,BREAK S GMTSNPG=1,GMTSTOF=GMTSEGN 16 I $D(GMTSQIT),(GMTSQIT]""),($D(GMTSTYP)) W @IOF D HEADER S GMTSTOF=GMTSEGN 17 Q 18 CKP1 ; Help Display of Optional Components for Navigation 19 N DA,I,J,K,L,X,XQORM,Y,GMTSY,TYP,DIC 20 I $S('$D(GMTSTYP):1,$D(GMTOPT):1,1:0) N DIR S DIR(0)="E" D ^DIR K DIR S:$D(DUOUT)!(GMTSLPG) GMTSQIT="" Q 21 S TYP=GMTSTYP 22 S DIC=142,DIC(0)="MZF",X="GMTS HS ADHOC OPTION" S Y=$$TYPE^GMTSULT 23 S GMTSTYP=+Y K DIC,X,Y 24 S XQORM=GMTSTYP_";GMT(142,",XQORM(0)="1AF\+",XQORM("A")="Press <RET> to continue, ^ to exit, or select component: " 25 S XQORM("??")="D HELP^GMTSUP1" I GMTSLPG,'$D(GMTSOBJ) W:'$D(GMTSOBJE) "* END * " 26 S XQORM("S")="I $D(^GMT(142,DA(1),1,DA,0)),($P(^GMT(142.1,$P(^GMT(142,DA(1),1,DA,0),U,2),0),U,6)'=""T"")" 27 D EN^XQORM W ! D @$S(Y=1:"BRNCH",1:"EVAL") 28 I $D(GMTSY),(GMTSY=0) K GMTSY G CKP1 29 S GMTSTYP=TYP 30 Q 31 BREAK ; Writes the Component Header 32 ; 33 ; If the variable GMTSOBJ exist, then the 34 ; Component Headers are suppressed with the 35 ; following exceptions: 36 ; 37 ; If GMTSOBJ("COMPONENT HEADER") exist, 38 ; then the Component Header will NOT be 39 ; suppressed 40 ; 41 ; If GMTSOBJ("BLANK LINE") exist, a blank 42 ; line will be written after the Component 43 ; Header 44 ; 45 N GMTSM,GMTSF S GMTSM=$$MUL,GMTSF=$$FST 46 I +GMTSM=0,$D(GMTSOBJ),'$D(GMTSOBJ("COMPONENT HEADER")),'$D(GMTSOBJ("BLANK LINE")) Q 47 N GMTS,GMTSUL,GMTSL S:'$D(GMTSLCMP) GMTSLCMP=0 48 S GMTSUL="",GMTSNPG=1,GMTS=$$CHDR,GMTSL=+($L($G(GMTS))),$P(GMTSUL,"-",+GMTSL)="-" 49 I $Y'>(IOSL-GMTSLO)!(+($$HF^GMTSU)) D 50 . I $D(GMTSOBJ) D Q 51 . . S GMTSLCMP=GMTSEGN 52 . . I +($G(GMTSM))>0!($D(GMTSOBJ("COMPONENT HEADER"))) D 53 . . . W:+GMTSF=0 ! W !,GMTS W:$D(GMTSOBJ("UNDERLINE")) !,GMTSUL 54 . . . W ! W:$D(GMTSOBJ("BLANK LINE")) ! 55 . W !,GMTS,! 56 . W:$Y'>(IOSL-GMTSLO) ?34,$S(GMTSEGN=GMTSLCMP:"(continued)",1:""),! 57 . S GMTSLCMP=GMTSEGN 58 Q 59 OLDB ; 60 S:'$D(GMTSLCMP) GMTSLCMP=0 61 S GMTS="",GMTSNPG=1 62 S $P(GMTS,"-",79-$L(GMTSEGH_GMTSEGL)/2)="" 63 S GMTS=GMTS_" "_GMTSEGH_GMTSEGL_" "_GMTS 64 I $Y'>(IOSL-GMTSLO)!(+($$HF^GMTSU)) D 65 . W !,GMTS,! 66 . W:$Y'>(IOSL-GMTSLO) ?34,$S(GMTSEGN=GMTSLCMP:"(continued)",1:""),! 67 . S GMTSLCMP=GMTSEGN 68 Q 69 HEADER ; Print Running Header 70 ; 71 ; If the variable GMTSOBJ exist, then the 72 ; Report Headers are suppressed with the 73 ; following exceptions: 74 ; 75 ; If GMTSOBJ("DATE LINE") exist, then the 76 ; Location/Report Date line will NOT be 77 ; suppressed. 78 ; 79 ; If GMTSOBJ("CONFIDENTIAL") exist, then 80 ; the Confidential Header Name line will 81 ; NOT be suppressed. 82 ; 83 ; If GMTSOBJ("REPORT HEADER") exist, then 84 ; the Report Header containing the patient's 85 ; name, SSAN, ward and DOB will NOT be 86 ; suppressed. 87 ; 88 ; If the variable GMTSOBJ("LABEL") contains 89 ; text, and the variable GMTSOBJ("USE LABEL") 90 ; exist, then this text will be printed before 91 ; the object text. 92 ; 93 ; If GMTSOBJ("REPORT DECEASED") exist, then 94 ; the optional line that displays for Deceased 95 ; patients will NOT be suppressed. 96 ; 97 ; Header Lines: 98 N GMTSVDT,DATA S DATA="" I +$G(GMTSPXD1)&+$G(GMTSPXD2) D 99 . Q:$G(GMTSOBJ) S:'$D(GMTSOBJE) DATA="Printed for data " S:$D(GMTSOBJE) DATA="Include data " 100 . I GMTSPXD1=GMTSPXD2 S DATA=DATA_"on "_GMTSPXD1 Q 101 . S DATA=DATA_"from "_GMTSPXD2_" to "_GMTSPXD1 102 I $D(GMTSCDT(0)),'$D(GMTSOBJ) S GMTSVDT=GMTSCDT(0) S:GMTSDTM'["Printed:" GMTSDTM="Printed: "_GMTSDTM 103 ; Location and Date of Report 104 I '$D(GMTSOBJ)!($D(GMTSOBJ("DATE LINE"))) D 105 . N GMTSLOC S GMTSLOC=$S('$D(GMTSOBJ("DATE LINE")):$P($G(GMTSSC),U,2),1:"") 106 . W !,$S($L(GMTSLOC):"Location: "_GMTSLOC_" ",1:"") 107 . W $S($D(GMTSVDT):GMTSVDT,1:"") 108 . W:'$D(GMTSOBJ("DATE LINE")) DATA,?(79-$L(GMTSDTM)),GMTSDTM 109 . W:$D(GMTSOBJ("DATE LINE")) DATA,?(74-$L(GMTSDTM)),GMTSDTM 110 ; Confidential Header Name 111 S:'$D(GMTSPG) GMTSPG=0 112 S GMTSPG=GMTSPG+1,GMTSHDR=" CONFIDENTIAL "_GMTSTITL_" SUMMARY " 113 S GMTSHDR=GMTSHDR_$S($E(IOST,1)="C":"",1:" pg. "_GMTSPG) 114 S GMTS="" S:'$D(GMTSOBJ) $P(GMTS,"*",(77-$L(GMTSHDR))\2)="*" 115 S:$D(GMTSOBJ) $P(GMTS,"*",(72-$L(GMTSHDR))\2)="*" 116 S GMTSHDR=GMTS_" "_GMTSHDR_" "_GMTS 117 I '$D(GMTSOBJ)!($D(GMTSOBJ("CONFIDENTIAL"))) W !,GMTSHDR,"*" 118 ; Name, SSAN, Ward, DOB 119 I '$D(GMTSLFG) D 120 . I $G(GMTSPHDR("TWO")) D 121 . . I $D(GMTSOBJ),'$D(GMTSOBJ("REPORT HEADER")),$L($G(GMTSOBJ("LABEL"))) D LABEL 122 . . I $D(GMTSOBJ),'$D(GMTSOBJ("REPORT HEADER")) Q 123 . . W !,GMTSPHDR("NMSSN"),?GMTSPHDR("DOBS"),GMTSPHDR("DOB") 124 . . W !,?GMTSPHDR("WARDRBS"),GMTSPHDR("WARDRB") 125 . E D 126 . . I $D(GMTSOBJ),'$D(GMTSOBJ("REPORT HEADER")),$L($G(GMTSOBJ("LABEL"))) D LABEL 127 . . I $D(GMTSOBJ),'$D(GMTSOBJ("REPORT HEADER")) Q 128 . . W !,GMTSPHDR("NMSSN"),?GMTSPHDR("WARDRBS") 129 . . W GMTSPHDR("WARDRB"),?GMTSPHDR("DOBS"),GMTSPHDR("DOB") 130 ; Deceased 131 ; 132 I '$D(GMTSOBJ)!($D(GMTSOBJ("DECEASED"))) D 133 . W:+$G(VADM(6)) !,?26,"** DECEASED "_$P(VADM(6),U,2)_" **" 134 W:'$D(GMTSOBJ) ! 135 Q 136 BRNCH ; Checks abbreviation to branch to a different component 137 N GMTINX,LIM,CREC,SBS 138 I Y,("+-"[X) S:X="-" GMTSEGN=GMTSTOF-1 S (GMTSY,GMTSQIT)=1,GMTSLPG=0 Q 139 I X="^^" S DIROUT=1,GMTSQIT="" Q 140 I Y,(X?1"^^".E) Q 141 S GMTINX=$S($D(^GMT(142,GMTSTYP,1,+Y(1),0)):$P(^(0),U,2),1:"") 142 I 'GMTINX S GMTSY=0 Q 143 I '$D(GMTSEGI(GMTINX)) N GMI,GMJ,GMTSDFLT S GMI=1,GMJ=GMTSEGC,GMTSDFLT=1 D LOAD^GMTSADH S GMTSEGC=GMTSEGC+1 144 I '$D(GMTSEGI(GMTINX)) S GMTINX="",GMTSY=0 Q 145 S LIM=$P(Y(1),U,4) I LIM'["=" G NOLIM 146 S CREC=^GMT(142.1,GMTINX,0),SBS=GMTSEGI(GMTINX) D CMPLIM^GMTSADH2 147 I $D(DIROUT) S GMTSQIT="" Q 148 NOLIM ; No limits 149 S GMTSEGN=GMTSEGI(GMTINX)-1,(GMTSY,GMTSQIT)=1,GMTSLPG=0 150 Q 151 ; 152 EVAL ; Evaluate input to determine quit or continue 153 Q:'$D(X) 154 S:$D(GMTSEXIT) GMTSEXIT=$G(X) 155 S:$D(DTOUT) DIROUT=1 I $S(X="^^":1,GMTSLPG:1,$D(DIROUT):1,X="^":1,1:0) S GMTSQIT="" 156 I +$G(GMPSAP),(X="^") S GMDUOUT=1 157 Q 158 MUL(X) ; Multiple Components in Type 159 N GMTSF,GMTSL S GMTSF=$O(GMTSEG(0)),GMTSL=$O(GMTSEG(" "),-1) 160 Q:+GMTSF=+GMTSL 0 Q 1 161 FST(X) ; First Component in Type 162 N GMTSF,GMTSL S GMTSF=$O(GMTSEG(0)),GMTSL=+($G(GMTSEGN)) 163 Q:+GMTSF=+GMTSL 1 Q 0 164 CHDR(X) ; Component Header 165 N GMTSN,GMTSH,GMTSL,GMTS S GMTSN=$$CNAM,GMTSH=$G(GMTSEGH) 166 S GMTSL=$G(GMTSEGL),GMTS="",$P(GMTS,"-",79-$L(GMTSH_GMTSL)/2)="" 167 S X=GMTS_" "_GMTSH_GMTSL_" "_GMTS Q:'$D(GMTSOBJ) X 168 S:$L(GMTSH)&($D(GMTSOBJ("COMPONENT HEADER"))) GMTSN=GMTSH 169 S:$L(GMTSL)&($L(GMTSN))&($D(GMTSOBJ("LIMITS"))) GMTSN=GMTSN_" "_GMTSL 170 S X=GMTSN Q X 171 CNAM(X) ; Component Name 172 N GMTSH S GMTSH=+($P($G(GMTSEG(+($G(GMTSEGN)))),"^",2)) 173 S X=$P($G(^GMT(142.1,+GMTSH,0)),"^",1) Q X 174 LABEL ; Label 175 Q:'$D(GMTSOBJ("USE LABEL")) N LABEL S LABEL=$G(GMTSOBJ("LABEL")) 176 W !,LABEL W:$L(LABEL) ! W:$D(GMTSOBJ("LABEL BLANK LINE")) ! 177 Q 178 LABDAT ; Label/Date 179 Q:'$D(GMTSOBJ("USE LABEL")) N LABEL S LABEL=$G(GMTSOBJ("LABEL")) 180 I '$D(GMTSOBJ("DATE LINE")),$D(GMTSOBJ("LABEL")),$L(LABEL),$L($G(GMTSDTM)) S LABEL=LABEL_$J("",((79-$L(GMTSDTM))-$L(LABEL)))_GMTSDTM 181 I '$D(GMTSOBJ("DATE LINE")),$D(GMTSOBJ("LABEL")),'$L(LABEL),$L($G(GMTSDTM)) S LABEL="Information as of "_$G(GMTSDTM) 182 W !,LABEL W:$L(LABEL) ! W:$D(GMTSOBJ("LABEL BLANK LINE")) ! 183 Q
Note:
See TracChangeset
for help on using the changeset viewer.
