GMTSOBA ;SLC/KER,PWC - HS Object - Ask ;July 17, 2019@10:12 AM
;;2.7;Health Summary;**58,89,130**;Oct 20, 1995;Build 1
;
; External References
; DBIA 10018 ^DIE (file #142.5)
; DBIA 10026 ^DIR
; DBIA 10103 $$FMTE^XLFDT
; DBIA 10103 $$NOW^XLFDT
;
OBJ ; Create/Edit Object
N DA,X,Y,DIE,DR,GMTSED,GMTSCON,GMTSLBL,GMTSLBB,GMTSULB,GMTSHDR
N GMTSRDT,GMTSCON,GMTSRHD,GMTSNEW,GMTSNEWO,GMTSDES,GMTSCHD,GMTSLIM
N GMTSBLK,GMTSQ,GMTSDEC,GMTSNOD,GMTSOWN,GMTSDT,GMTSI,GMTSDA,GMTSUND
N GMTSTIM,GMTSTI,GMTSOI,GMTSNDAT
S (GMTSHDR,GMTSRDT,GMTSCON,GMTSRHD,GMTSCHD,GMTSUND,GMTSLIM,GMTSULB,GMTSLBB,GMTSBLK,GMTSDEC,GMTSNOD)=0,GMTSOWN="",GMTSDES=1
S:'$L($G(GMTSNAM)) DA=$$LK^GMTSOBL Q:+($G(GMTSQ))>0
S:$L($G(GMTSNAM)) DA=$$HSO^GMTSOBL($G(GMTSNAM)) Q:+($G(GMTSQ))>0 Q:+($G(DA))'>0
S:$L($G(GMTSNAM)) GMTSNEW=+($P($G(DA),"^",3)),DA=+($P($G(DA),"^",1))
Q:+($G(DA))'>0 S (GMTSDA,GMTSOI)=+($G(DA)),GMTSTI=$P($G(^GMT(142.5,+GMTSOI,0)),"^",3) Q:+GMTSTI'>0
S GMTSLBL="" K GMTSOBJ S GMTSCON=1
I $L($G(GMTSNAM)),+GMTSNEW'>0,+DA>0 D Q:+($G(GMTSCON))'>0 Q:+($G(GMTSQ))>0
. N GMTSOWN S GMTSOWN=$P($G(^GMT(142.5,+DA,0)),"^",17)
. I +GMTSOWN>0,+($G(DUZ))>0,+GMTSOWN'=+($G(DUZ)),'$D(^XUSEC("GMTSMGR",DUZ)) S GMTSCON=0 Q
. W !," Object '",GMTSNAM,"' already exist" S GMTSCON=$$CONT Q:+($G(GMTSCON))'>0
. N X,Y,DIR,DIE,DR,GMTSDEF,GMTSDICA,GMTSNAM,GMTSTYPE
. W ! S GMTSDEF=+($P($G(^GMT(142.5,+($G(DA)),0)),"^",3))
. S GMTSDEF=$S(+GMTSDEF>0:+GMTSDEF,1:"")
. S GMTSDICA=" Enter/Edit HEALTH SUMMARY TYPE: "
. K DTOUT,DUOUT,DIRUT,DIROUT
. S GMTSTYPE=$$TY^GMTSOBL(GMTSDEF)
. I $D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT)) S GMTSQ=1 Q
. ;VSR - pwc GMTS*2.7*130 change //// to /// for validation before storage
. S DR=".03///^S X=$G(GMTSTYPE)"
. S DIE="^GMT(142.5,",DA=+($G(DA)) S GMTSED=0
. F GMTSI=1:1:3 Q:GMTSI>3 L +^GMT(142.5,+($G(DA))):0 H:'$T 1 I $T D
. . D ^DIE S GMTSED=1 S $P(^GMT(142.5,+DA,0),U,19)=$$NOW^XLFDT,GMTSI=4
. . S:+($G(DUZ))>0 $P(^GMT(142.5,+DA,0),"^",17)=+($G(DUZ))
. I 'GMTSED S GMTSQ=1 K GMTSOBJ W !," Record Locked by another user" Q
. L -^GMT(142.5,+($G(DA))) S GMTST=+($P($G(^GMT(142.5,+DA,0)),U,3))
K:+($G(GMTSQ))>0 GMTSOBJ Q:+($G(GMTSQ))>0
D ALL K:+($G(GMTSQ))>0 GMTSOBJ S:+($G(GMTSQ))>0 GMTSDES=0 Q:+($G(GMTSQ))>0 N DIE,DR
S GMTSHDR=+($G(GMTSOBJ("HEADER")))
S GMTSLBL=$G(GMTSLBL) I GMTSHDR>0 D
. S GMTSRDT=$S($D(GMTSOBJ("DATE LINE")):1,1:0)
. S GMTSCON=$S($D(GMTSOBJ("CONFIDENTIAL")):1,1:0)
. S GMTSRHD=$S($D(GMTSOBJ("REPORT HEADER")):1,1:0)
. S GMTSCHD=$S($D(GMTSOBJ("COMPONENT HEADER")):1,1:0)
. S GMTSUND=$S($D(GMTSOBJ("UNDERLINE")):1,1:0)
. S GMTSLIM=$S($D(GMTSOBJ("LIMITS")):1,1:0)
. S GMTSBLK=$S($D(GMTSOBJ("BLANK LINE")):1,1:0)
. S GMTSDEC=$S($D(GMTSOBJ("DECEASED")):1,1:0)
. S GMTSULB=$S($D(GMTSOBJ("USE LABEL")):1,1:0)
. S GMTSLBB=$S($D(GMTSOBJ("LABEL BLANK LINE")):1,1:0)
. S GMTSNDAT=$G(GMTSOBJ("NO DATA"))
I GMTSHDR'>0 S (GMTSRDT,GMTSCON,GMTSRHD,GMTSCHD,GMTSUND,GMTSLIM,GMTSBLK,GMTSDEC,GMTSULB,GMTSLBB)=0,GMTSLBL=""
S GMTSNOD=$S($D(GMTSOBJ("SUPPRESS COMPONENTS")):1,1:0)
S:+GMTSCHD'>0 (GMTSLIM,GMTSBLK)=0
S:'$L($G(GMTSLBL)) GMTSLBL="@",(GMTSULB,GMTSLBB)=0
; ;VSR pwc GMTS*2.7*130 replace //// with /// for validation before storage
N DR S DR=".02///^S X=$G(GMTSLBL);"
S:$L($G(GMTSTIM))&($G(GMTSTIM)'="@") DR=DR_".04///^S X=$G(GMTSTIM);"
S DR=DR_".05///^S X=$G(GMTSNOD);",DR=DR_".06///^S X=$G(GMTSHDR);"
S DR=DR_".07///^S X=$G(GMTSULB);",DR=DR_".08///^S X=$G(GMTSLBB);"
S DR=DR_".09///^S X=$G(GMTSRDT);",DR=DR_".1///^S X=$G(GMTSCON);"
S DR=DR_".11///^S X=$G(GMTSRHD);",DR=DR_".12///^S X=$G(GMTSCHD);"
S DR=DR_".13///^S X=$G(GMTSUND);",DR=DR_".14///^S X=$G(GMTSLIM);"
S DR=DR_".15///^S X=$G(GMTSBLK);",DR=DR_".16///^S X=$G(GMTSDEC);"
S DR=DR_"2///^S X=$G(GMTSNDAT);"
; End of VSR patch GMTS*2.7*130
S:+($G(GMTSDES))>0 DR=DR_"1" S:$E(DR,1)=";" DR=$E(DR,2,$L(DR)) S:$E(DR,$L(DR))=";" DR=$E(DR,1,($L(DR)-1))
S DIE="^GMT(142.5,",DA=+($G(DA)) S GMTSED=0 W:+($G(GMTSDES))>0 !
F GMTSI=1:1:3 Q:GMTSI>3 L +^GMT(142.5,+($G(DA))):0 H:'$T 1 I $T D
. D ^DIE S GMTSED=1 S $P(^GMT(142.5,+DA,0),U,19)=$$NOW^XLFDT,GMTSI=4
. S:$G(GMTSTIM)="@" $P(^GMT(142.5,+DA,0),U,4)=""
I 'GMTSED S GMTSQ=1 K GMTSOBJ W !," Record Locked by another user" Q
L -^GMT(142.5,+($G(DA))) S GMTST=+($P($G(^GMT(142.5,+DA,0)),U,3))
K GMTSOBJ Q
;
ALL ; Print HS Header
N X,Y,DIR,DIROUT,DUOUT,DTOUT S GMTSOBJ="",GMTSQ=0 D RP Q:+($G(GMTSQ))>0
S DIR("A")=" Print standard Health Summary Header with the Object? "
S DIR("B")="N",DIR(0)="YAO",(DIR("?"),DIR("??"))="^D ALL^GMTSOBH"
W ! D ^DIR S:$D(DIROUT)!($D(DTOUT)) GMTSQ=1
S:Y["^"!(X["^") GMTSE=1,GMTSQ=1,GMTSDES=0
K:+($G(GMTSQ))>0!($D(DUOUT)) GMTSOBJ Q:+($G(GMTSQ))>0!($D(DUOUT))
S X=+($G(Y)) K:+X>0 GMTSOBJ S:+X'>0 GMTSOBJ=""
S GMTSOBJ("HEADER")=$S(+X'>0:1,1:0)
I +X'>0 D
. W ! D PART Q:+($G(GMTSQ))>1 W ! S GMTSLBL="" D LBL^GMTSOBA2
. S GMTSLBL=$S($L($G(GMTSOBJ("LABEL"))):$G(GMTSOBJ("LABEL")),1:"@")
. K:'$L($G(GMTSOBJ("LABEL"))) GMTSLBL,GMTSOBJ("LABEL BLANK LINE"),GMTSOBJ("USE LABEL")
W ! D SC^GMTSOBA2 K:+($G(GMTSQ))>0 GMTSOBJ
W ! D NODATA^GMTSOBA2 K:+($G(GMTSQ))>0 GMTSOBJ
Q
;
RP ; Report Period
Q:+($G(GMTSQ))>0 N X,Y,DIR,DIROUT,DUOUT,DTOUT,GMTSDEF
S GMTSTIM=$$RP^GMTSOBT($G(GMTSTI),$G(GMTSOI)) S:+GMTSTIM<0 GMTSQ=1
Q
;
PART ; Print Partial Header
K:+($G(GMTSQ))>0 GMTSOBJ Q:+($G(GMTSQ))>0 W !," Partial Header:"
D:$D(GMTSOBJ) RD,RC,RH,CH^GMTSOBA2,DE^GMTSOBA2 Q
RD ; Report Date
Q:+($G(GMTSQ))>0 N X,Y,DIR,DIROUT,DUOUT,DTOUT,GMTSDEF
S GMTSDEF=$P($G(^GMT(142.5,+($G(GMTSDA)),0)),U,9)
S GMTSDEF=$S(+GMTSDEF>0:"Y",1:"N")
S GMTSOBJ("DATE LINE")="",DIR("A")=" Print Report Date? "
S DIR("B")=GMTSDEF,DIR(0)="YAO",(DIR("?"),DIR("??"))="^D RD^GMTSOBH"
D ^DIR S:$D(DIROUT)!($D(DTOUT)) GMTSQ=1
S:Y["^"!(X["^") GMTSE=1,GMTSQ=1,GMTSDES=0
K:+($G(GMTSQ))>0 GMTSOBJ("DATE LINE") Q:+($G(GMTSQ))>0
S X=+($G(Y)) K:+X'>0 GMTSOBJ("DATE LINE") Q
RC ; Confidentiality Banner
Q:+($G(GMTSQ))>0 N X,Y,DIR,DIROUT,DUOUT,DTOUT,GMTSDEF
S GMTSOBJ("CONFIDENTIAL")="",DIR("A")=" Print Confidentiality Banner? "
S GMTSDEF=$P($G(^GMT(142.5,+($G(GMTSDA)),0)),U,10)
S GMTSDEF=$S(+GMTSDEF>0:"Y",1:"N")
S DIR("B")=GMTSDEF,DIR(0)="YAO",(DIR("?"),DIR("??"))="^D RC^GMTSOBH"
D ^DIR S:$D(DIROUT)!($D(DTOUT)) GMTSQ=1
S:Y["^"!(X["^") GMTSE=1,GMTSQ=1,GMTSDES=0
K:+($G(GMTSQ))>0 GMTSOBJ("CONFIDENNTIAL") Q:+($G(GMTSQ))>0
S X=+($G(Y)) K:+X'>0 GMTSOBJ("CONFIDENTIAL") Q
RH ; Report Header
Q:+($G(GMTSQ))>0 N X,Y,DIR,DIROUT,DUOUT,DTOUT,GMTSDEF
S GMTSOBJ("REPORT HEADER")="",DIR("A")=" Print Report Header? "
S GMTSDEF=$P($G(^GMT(142.5,+($G(GMTSDA)),0)),U,11)
S GMTSDEF=$S(+GMTSDEF>0:"Y",1:"N")
S DIR("B")=GMTSDEF,DIR(0)="YAO",(DIR("?"),DIR("??"))="^D RH^GMTSOBH"
D ^DIR S:$D(DIROUT)!($D(DTOUT)) GMTSQ=1
S:Y["^"!(X["^") GMTSE=1,GMTSQ=1,GMTSDES=0
K:+($G(GMTSQ))>0 GMTSOBJ("REPORT HEADER") Q:+($G(GMTSQ))>0
S X=+($G(Y)) K:+X'>0 GMTSOBJ("REPORT HEADER") Q
;
CONT(X) ; Continue with Edit
N DIR,DIROUT,DTOUT
S DIR(0)="YAO",DIR("B")="NO",DIR("A")=" Do you want to edit the object? Y/N "
D ^DIR S X=+($G(Y)) Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSOBA 7252 printed Nov 22, 2024@17:08:24 Page 2
GMTSOBA ;SLC/KER,PWC - HS Object - Ask ;July 17, 2019@10:12 AM
+1 ;;2.7;Health Summary;**58,89,130**;Oct 20, 1995;Build 1
+2 ;
+3 ; External References
+4 ; DBIA 10018 ^DIE (file #142.5)
+5 ; DBIA 10026 ^DIR
+6 ; DBIA 10103 $$FMTE^XLFDT
+7 ; DBIA 10103 $$NOW^XLFDT
+8 ;
OBJ ; Create/Edit Object
+1 NEW DA,X,Y,DIE,DR,GMTSED,GMTSCON,GMTSLBL,GMTSLBB,GMTSULB,GMTSHDR
+2 NEW GMTSRDT,GMTSCON,GMTSRHD,GMTSNEW,GMTSNEWO,GMTSDES,GMTSCHD,GMTSLIM
+3 NEW GMTSBLK,GMTSQ,GMTSDEC,GMTSNOD,GMTSOWN,GMTSDT,GMTSI,GMTSDA,GMTSUND
+4 NEW GMTSTIM,GMTSTI,GMTSOI,GMTSNDAT
+5 SET (GMTSHDR,GMTSRDT,GMTSCON,GMTSRHD,GMTSCHD,GMTSUND,GMTSLIM,GMTSULB,GMTSLBB,GMTSBLK,GMTSDEC,GMTSNOD)=0
SET GMTSOWN=""
SET GMTSDES=1
+6 if '$LENGTH($GET(GMTSNAM))
SET DA=$$LK^GMTSOBL
if +($GET(GMTSQ))>0
QUIT
+7 if $LENGTH($GET(GMTSNAM))
SET DA=$$HSO^GMTSOBL($GET(GMTSNAM))
if +($GET(GMTSQ))>0
QUIT
if +($GET(DA))'>0
QUIT
+8 if $LENGTH($GET(GMTSNAM))
SET GMTSNEW=+($PIECE($GET(DA),"^",3))
SET DA=+($PIECE($GET(DA),"^",1))
+9 if +($GET(DA))'>0
QUIT
SET (GMTSDA,GMTSOI)=+($GET(DA))
SET GMTSTI=$PIECE($GET(^GMT(142.5,+GMTSOI,0)),"^",3)
if +GMTSTI'>0
QUIT
+10 SET GMTSLBL=""
KILL GMTSOBJ
SET GMTSCON=1
+11 IF $LENGTH($GET(GMTSNAM))
IF +GMTSNEW'>0
IF +DA>0
Begin DoDot:1
+12 NEW GMTSOWN
SET GMTSOWN=$PIECE($GET(^GMT(142.5,+DA,0)),"^",17)
+13 IF +GMTSOWN>0
IF +($GET(DUZ))>0
IF +GMTSOWN'=+($GET(DUZ))
IF '$DATA(^XUSEC("GMTSMGR",DUZ))
SET GMTSCON=0
QUIT
+14 WRITE !," Object '",GMTSNAM,"' already exist"
SET GMTSCON=$$CONT
if +($GET(GMTSCON))'>0
QUIT
+15 NEW X,Y,DIR,DIE,DR,GMTSDEF,GMTSDICA,GMTSNAM,GMTSTYPE
+16 WRITE !
SET GMTSDEF=+($PIECE($GET(^GMT(142.5,+($GET(DA)),0)),"^",3))
+17 SET GMTSDEF=$SELECT(+GMTSDEF>0:+GMTSDEF,1:"")
+18 SET GMTSDICA=" Enter/Edit HEALTH SUMMARY TYPE: "
+19 KILL DTOUT,DUOUT,DIRUT,DIROUT
+20 SET GMTSTYPE=$$TY^GMTSOBL(GMTSDEF)
+21 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))!($DATA(DIROUT))
SET GMTSQ=1
QUIT
+22 ;VSR - pwc GMTS*2.7*130 change //// to /// for validation before storage
+23 SET DR=".03///^S X=$G(GMTSTYPE)"
+24 SET DIE="^GMT(142.5,"
SET DA=+($GET(DA))
SET GMTSED=0
+25 FOR GMTSI=1:1:3
if GMTSI>3
QUIT
LOCK +^GMT(142.5,+($GET(DA))):0
if '$TEST
HANG 1
IF $TEST
Begin DoDot:2
+26 DO ^DIE
SET GMTSED=1
SET $PIECE(^GMT(142.5,+DA,0),U,19)=$$NOW^XLFDT
SET GMTSI=4
+27 if +($GET(DUZ))>0
SET $PIECE(^GMT(142.5,+DA,0),"^",17)=+($GET(DUZ))
End DoDot:2
+28 IF 'GMTSED
SET GMTSQ=1
KILL GMTSOBJ
WRITE !," Record Locked by another user"
QUIT
+29 LOCK -^GMT(142.5,+($GET(DA)))
SET GMTST=+($PIECE($GET(^GMT(142.5,+DA,0)),U,3))
End DoDot:1
if +($GET(GMTSCON))'>0
QUIT
if +($GET(GMTSQ))>0
QUIT
+30 if +($GET(GMTSQ))>0
KILL GMTSOBJ
if +($GET(GMTSQ))>0
QUIT
+31 DO ALL
if +($GET(GMTSQ))>0
KILL GMTSOBJ
if +($GET(GMTSQ))>0
SET GMTSDES=0
if +($GET(GMTSQ))>0
QUIT
NEW DIE,DR
+32 SET GMTSHDR=+($GET(GMTSOBJ("HEADER")))
+33 SET GMTSLBL=$GET(GMTSLBL)
IF GMTSHDR>0
Begin DoDot:1
+34 SET GMTSRDT=$SELECT($DATA(GMTSOBJ("DATE LINE")):1,1:0)
+35 SET GMTSCON=$SELECT($DATA(GMTSOBJ("CONFIDENTIAL")):1,1:0)
+36 SET GMTSRHD=$SELECT($DATA(GMTSOBJ("REPORT HEADER")):1,1:0)
+37 SET GMTSCHD=$SELECT($DATA(GMTSOBJ("COMPONENT HEADER")):1,1:0)
+38 SET GMTSUND=$SELECT($DATA(GMTSOBJ("UNDERLINE")):1,1:0)
+39 SET GMTSLIM=$SELECT($DATA(GMTSOBJ("LIMITS")):1,1:0)
+40 SET GMTSBLK=$SELECT($DATA(GMTSOBJ("BLANK LINE")):1,1:0)
+41 SET GMTSDEC=$SELECT($DATA(GMTSOBJ("DECEASED")):1,1:0)
+42 SET GMTSULB=$SELECT($DATA(GMTSOBJ("USE LABEL")):1,1:0)
+43 SET GMTSLBB=$SELECT($DATA(GMTSOBJ("LABEL BLANK LINE")):1,1:0)
+44 SET GMTSNDAT=$GET(GMTSOBJ("NO DATA"))
End DoDot:1
+45 IF GMTSHDR'>0
SET (GMTSRDT,GMTSCON,GMTSRHD,GMTSCHD,GMTSUND,GMTSLIM,GMTSBLK,GMTSDEC,GMTSULB,GMTSLBB)=0
SET GMTSLBL=""
+46 SET GMTSNOD=$SELECT($DATA(GMTSOBJ("SUPPRESS COMPONENTS")):1,1:0)
+47 if +GMTSCHD'>0
SET (GMTSLIM,GMTSBLK)=0
+48 if '$LENGTH($GET(GMTSLBL))
SET GMTSLBL="@"
SET (GMTSULB,GMTSLBB)=0
+49 ; ;VSR pwc GMTS*2.7*130 replace //// with /// for validation before storage
+50 NEW DR
SET DR=".02///^S X=$G(GMTSLBL);"
+51 if $LENGTH($GET(GMTSTIM))&($GET(GMTSTIM)'="@")
SET DR=DR_".04///^S X=$G(GMTSTIM);"
+52 SET DR=DR_".05///^S X=$G(GMTSNOD);"
SET DR=DR_".06///^S X=$G(GMTSHDR);"
+53 SET DR=DR_".07///^S X=$G(GMTSULB);"
SET DR=DR_".08///^S X=$G(GMTSLBB);"
+54 SET DR=DR_".09///^S X=$G(GMTSRDT);"
SET DR=DR_".1///^S X=$G(GMTSCON);"
+55 SET DR=DR_".11///^S X=$G(GMTSRHD);"
SET DR=DR_".12///^S X=$G(GMTSCHD);"
+56 SET DR=DR_".13///^S X=$G(GMTSUND);"
SET DR=DR_".14///^S X=$G(GMTSLIM);"
+57 SET DR=DR_".15///^S X=$G(GMTSBLK);"
SET DR=DR_".16///^S X=$G(GMTSDEC);"
+58 SET DR=DR_"2///^S X=$G(GMTSNDAT);"
+59 ; End of VSR patch GMTS*2.7*130
+60 if +($GET(GMTSDES))>0
SET DR=DR_"1"
if $EXTRACT(DR,1)=";"
SET DR=$EXTRACT(DR,2,$LENGTH(DR))
if $EXTRACT(DR,$LENGTH(DR))=";"
SET DR=$EXTRACT(DR,1,($LENGTH(DR)-1))
+61 SET DIE="^GMT(142.5,"
SET DA=+($GET(DA))
SET GMTSED=0
if +($GET(GMTSDES))>0
WRITE !
+62 FOR GMTSI=1:1:3
if GMTSI>3
QUIT
LOCK +^GMT(142.5,+($GET(DA))):0
if '$TEST
HANG 1
IF $TEST
Begin DoDot:1
+63 DO ^DIE
SET GMTSED=1
SET $PIECE(^GMT(142.5,+DA,0),U,19)=$$NOW^XLFDT
SET GMTSI=4
+64 if $GET(GMTSTIM)="@"
SET $PIECE(^GMT(142.5,+DA,0),U,4)=""
End DoDot:1
+65 IF 'GMTSED
SET GMTSQ=1
KILL GMTSOBJ
WRITE !," Record Locked by another user"
QUIT
+66 LOCK -^GMT(142.5,+($GET(DA)))
SET GMTST=+($PIECE($GET(^GMT(142.5,+DA,0)),U,3))
+67 KILL GMTSOBJ
QUIT
+68 ;
ALL ; Print HS Header
+1 NEW X,Y,DIR,DIROUT,DUOUT,DTOUT
SET GMTSOBJ=""
SET GMTSQ=0
DO RP
if +($GET(GMTSQ))>0
QUIT
+2 SET DIR("A")=" Print standard Health Summary Header with the Object? "
+3 SET DIR("B")="N"
SET DIR(0)="YAO"
SET (DIR("?"),DIR("??"))="^D ALL^GMTSOBH"
+4 WRITE !
DO ^DIR
if $DATA(DIROUT)!($DATA(DTOUT))
SET GMTSQ=1
+5 if Y["^"!(X["^")
SET GMTSE=1
SET GMTSQ=1
SET GMTSDES=0
+6 if +($GET(GMTSQ))>0!($DATA(DUOUT))
KILL GMTSOBJ
if +($GET(GMTSQ))>0!($DATA(DUOUT))
QUIT
+7 SET X=+($GET(Y))
if +X>0
KILL GMTSOBJ
if +X'>0
SET GMTSOBJ=""
+8 SET GMTSOBJ("HEADER")=$SELECT(+X'>0:1,1:0)
+9 IF +X'>0
Begin DoDot:1
+10 WRITE !
DO PART
if +($GET(GMTSQ))>1
QUIT
WRITE !
SET GMTSLBL=""
DO LBL^GMTSOBA2
+11 SET GMTSLBL=$SELECT($LENGTH($GET(GMTSOBJ("LABEL"))):$GET(GMTSOBJ("LABEL")),1:"@")
+12 if '$LENGTH($GET(GMTSOBJ("LABEL")))
KILL GMTSLBL,GMTSOBJ("LABEL BLANK LINE"),GMTSOBJ("USE LABEL")
End DoDot:1
+13 WRITE !
DO SC^GMTSOBA2
if +($GET(GMTSQ))>0
KILL GMTSOBJ
+14 WRITE !
DO NODATA^GMTSOBA2
if +($GET(GMTSQ))>0
KILL GMTSOBJ
+15 QUIT
+16 ;
RP ; Report Period
+1 if +($GET(GMTSQ))>0
QUIT
NEW X,Y,DIR,DIROUT,DUOUT,DTOUT,GMTSDEF
+2 SET GMTSTIM=$$RP^GMTSOBT($GET(GMTSTI),$GET(GMTSOI))
if +GMTSTIM<0
SET GMTSQ=1
+3 QUIT
+4 ;
PART ; Print Partial Header
+1 if +($GET(GMTSQ))>0
KILL GMTSOBJ
if +($GET(GMTSQ))>0
QUIT
WRITE !," Partial Header:"
+2 if $DATA(GMTSOBJ)
DO RD
DO RC
DO RH
DO CH^GMTSOBA2
DO DE^GMTSOBA2
QUIT
RD ; Report Date
+1 if +($GET(GMTSQ))>0
QUIT
NEW X,Y,DIR,DIROUT,DUOUT,DTOUT,GMTSDEF
+2 SET GMTSDEF=$PIECE($GET(^GMT(142.5,+($GET(GMTSDA)),0)),U,9)
+3 SET GMTSDEF=$SELECT(+GMTSDEF>0:"Y",1:"N")
+4 SET GMTSOBJ("DATE LINE")=""
SET DIR("A")=" Print Report Date? "
+5 SET DIR("B")=GMTSDEF
SET DIR(0)="YAO"
SET (DIR("?"),DIR("??"))="^D RD^GMTSOBH"
+6 DO ^DIR
if $DATA(DIROUT)!($DATA(DTOUT))
SET GMTSQ=1
+7 if Y["^"!(X["^")
SET GMTSE=1
SET GMTSQ=1
SET GMTSDES=0
+8 if +($GET(GMTSQ))>0
KILL GMTSOBJ("DATE LINE")
if +($GET(GMTSQ))>0
QUIT
+9 SET X=+($GET(Y))
if +X'>0
KILL GMTSOBJ("DATE LINE")
QUIT
RC ; Confidentiality Banner
+1 if +($GET(GMTSQ))>0
QUIT
NEW X,Y,DIR,DIROUT,DUOUT,DTOUT,GMTSDEF
+2 SET GMTSOBJ("CONFIDENTIAL")=""
SET DIR("A")=" Print Confidentiality Banner? "
+3 SET GMTSDEF=$PIECE($GET(^GMT(142.5,+($GET(GMTSDA)),0)),U,10)
+4 SET GMTSDEF=$SELECT(+GMTSDEF>0:"Y",1:"N")
+5 SET DIR("B")=GMTSDEF
SET DIR(0)="YAO"
SET (DIR("?"),DIR("??"))="^D RC^GMTSOBH"
+6 DO ^DIR
if $DATA(DIROUT)!($DATA(DTOUT))
SET GMTSQ=1
+7 if Y["^"!(X["^")
SET GMTSE=1
SET GMTSQ=1
SET GMTSDES=0
+8 if +($GET(GMTSQ))>0
KILL GMTSOBJ("CONFIDENNTIAL")
if +($GET(GMTSQ))>0
QUIT
+9 SET X=+($GET(Y))
if +X'>0
KILL GMTSOBJ("CONFIDENTIAL")
QUIT
RH ; Report Header
+1 if +($GET(GMTSQ))>0
QUIT
NEW X,Y,DIR,DIROUT,DUOUT,DTOUT,GMTSDEF
+2 SET GMTSOBJ("REPORT HEADER")=""
SET DIR("A")=" Print Report Header? "
+3 SET GMTSDEF=$PIECE($GET(^GMT(142.5,+($GET(GMTSDA)),0)),U,11)
+4 SET GMTSDEF=$SELECT(+GMTSDEF>0:"Y",1:"N")
+5 SET DIR("B")=GMTSDEF
SET DIR(0)="YAO"
SET (DIR("?"),DIR("??"))="^D RH^GMTSOBH"
+6 DO ^DIR
if $DATA(DIROUT)!($DATA(DTOUT))
SET GMTSQ=1
+7 if Y["^"!(X["^")
SET GMTSE=1
SET GMTSQ=1
SET GMTSDES=0
+8 if +($GET(GMTSQ))>0
KILL GMTSOBJ("REPORT HEADER")
if +($GET(GMTSQ))>0
QUIT
+9 SET X=+($GET(Y))
if +X'>0
KILL GMTSOBJ("REPORT HEADER")
QUIT
+10 ;
CONT(X) ; Continue with Edit
+1 NEW DIR,DIROUT,DTOUT
+2 SET DIR(0)="YAO"
SET DIR("B")="NO"
SET DIR("A")=" Do you want to edit the object? Y/N "
+3 DO ^DIR
SET X=+($GET(Y))
QUIT X
