TIUHSOLM ;;SLC/AJB,AGP Display Health Summary Object for TIU Objects;27-MAR-2009
;;1.0;TEXT INTEGRATION UTILITIES;**135,249**;Jun 20, 1997;Build 48
;
EN(IEN,TIUIEN) ; -- main entry point for TIUHS OBJ DISPLAY
D EN^VALM("TIUHS OBJ DISPLAY")
Q
;
HDR ; -- header code
N CENTER,HEADER,TIUNAM,HSOBJNOD,TITLE,VALHDR,VALMSG
;S HSOBJNOD=$G(^GMT(142.5,IEN,0))
S TIUNAM=$P($G(^TIU(8925.1,TIUIEN,0)),U)
S TITLE="Detailed Display for "_TIUNAM
S CENTER=(IOM-$L(TITLE))/2
S HEADER=$$SETSTR^VALM1(TITLE,"",CENTER,$L(TITLE))
S VALMHDR(1)=HEADER
S VALMSG="?? More Actions"
D XQORM
Q
;
INIT ; -- init variables and list array
N LINE,OBJ,OBJDISP,OBJECT,VAL,VALUE
S LINE=0
;hs object heading
D EXTRACT^GMTSOBJ(IEN,.OBJ)
S HSTYNAM=$G(OBJ(IEN,.03,"E"))
S VALUE=$J("HS Object",25)_": "_$G(OBJ(IEN,.01,"E")),LINE=LINE+1
D SET^VALM10(LINE,VALUE)
I $G(OBJ(IEN,.02,"E"))'="" D
. S VALUE=$J($G(OBJ(IEN,.02,"PROMPT")),25)_": "_$G(OBJ(IEN,.02,"E"))
. S LINE=LINE+1
. D SET^VALM10(LINE,VALUE)
S VALUE=$J($G(OBJ(IEN,.03,"PROMPT")),25)_": "_HSTYNAM,LINE=LINE+1
D SET^VALM10(LINE,VALUE)
S VALUE=$J($G(OBJ(IEN,.04,"PROMPT")),25)_": "_$G(OBJ(IEN,.04,"E")),LINE=LINE+1
D SET^VALM10(LINE,VALUE)
S VALUE=$J($G(OBJ(IEN,.17,"PROMPT")),25)_": "_$G(OBJ(IEN,.17,"E"))
S LINE=LINE+1
D SET^VALM10(LINE,VALUE)
S VALUE=" ",LINE=LINE+1 D SET^VALM10(LINE,VALUE)
S OBJDISP="HS Object",CENTER=(IOM-$L(OBJDISP))/2
S VALUE=$$SETSTR^VALM1(OBJDISP,"",CENTER,$L(OBJDISP))
S LINE=LINE+1 D SET^VALM10(LINE,VALUE)
S VALUE=" ",LINE=LINE+1 D SET^VALM10(LINE,VALUE)
S VALUE=$J($G(OBJ(IEN,.07,"PROMPT")),29)_": "_$G(OBJ(IEN,.07,"E"))
S VAL=$$LJ^XLFSTR(VALUE,40) S VALUE=VAL_$J($G(OBJ(IEN,.09,"PROMPT")),28)_": "_$G(OBJ(IEN,.09,"E"))
S LINE=LINE+1
D SET^VALM10(LINE,VALUE)
S VALUE=$J($G(OBJ(IEN,.08,"PROMPT")),29)_": "_$G(OBJ(IEN,.08,"E"))
S VAL=$$LJ^XLFSTR(VALUE,40) S VALUE=VAL_$J($G(OBJ(IEN,.1,"PROMPT")),28)_": "_$G(OBJ(IEN,.1,"E"))
S LINE=LINE+1
D SET^VALM10(LINE,VALUE)
S VALUE=$J("Customized Header",29)_": "_$G(OBJ(IEN,.06,"E"))
S VAL=$$LJ^XLFSTR(VALUE,40) S VALUE=VAL_$J($G(OBJ(IEN,.09,"PROMPT")),28)_": "_$G(OBJ(IEN,.09,"E"))
S LINE=LINE+1
D SET^VALM10(LINE,VALUE)
S VALUE=$J($G(OBJ(IEN,.05,"PROMPT")),29)_": "_$G(OBJ(IEN,.05,"E"))
S VAL=$$LJ^XLFSTR(VALUE,40) S VALUE=VAL_$J($G(OBJ(IEN,.12,"PROMPT")),28)_": "_$G(OBJ(IEN,.12,"E"))
S LINE=LINE+1
D SET^VALM10(LINE,VALUE)
S VALUE=$J($G(OBJ(IEN,.16,"PROMPT")),29)_": "_$G(OBJ(IEN,.16,"E"))
S VAL=$$LJ^XLFSTR(VALUE,40) S VALUE=VAL_$J($G(OBJ(IEN,.14,"PROMPT")),28)_": "_$G(OBJ(IEN,.14,"E"))
S LINE=LINE+1
D SET^VALM10(LINE,VALUE)
S VALUE=$J($G(OBJ(IEN,.2,"PROMPT")),29)_": "_$G(OBJ(IEN,.2,"E"))
S VAL=$$LJ^XLFSTR(VALUE,40) S VALUE=VAL_$J($G(OBJ(IEN,.13,"PROMPT")),28)_": "_$G(OBJ(IEN,.13,"E"))
S LINE=LINE+1
D SET^VALM10(LINE,VALUE)
S VALUE=$$RJ^XLFSTR("Blank Line After Header",68)_": "_$G(OBJ(IEN,.15,"E"))
S LINE=LINE+1
D SET^VALM10(LINE,VALUE)
S VALUE=$$RJ^XLFSTR("Overwrite No Data",19)_": "_$G(OBJ(IEN,2,"E"))
S LINE=LINE+1
D SET^VALM10(LINE,VALUE)
S VALMCNT=LINE
Q
;
EHSO ;
N HSOBNAM,VALUE
D FULL^VALM1
I $P($G(^GMT(142.5,HSOBJ,0)),U,20)=1 W !,"Can't edit this HS Object: Only the owner can edit this HS Object" H 2 Q
I $P($G(^GMT(142.5,HSOBJ,0)),U,17)'=DUZ,'$D(^XUSEC("GMTSMGR",DUZ)) W !,"Can't edit this HS Object: Only the owner or the HS Manager can edit this HS Object" H 2 Q
S HSOBNAM=$P($G(^GMT(142.5,IEN,0)),U)
S VALUE=$$CRE^GMTSOBJ(HSOBNAM)
D CLEAN^VALM10
D INIT
Q
;
CHST ;
N DA,DIC,DIE,DIR,DIROUT,DR,DTOUT,DUOUT,HSIEN,POP,TEXT,X,Y,YESNO
D FULL^VALM1
I $P($G(^GMT(142.5,HSOBJ,0)),U,20)=1 W !,"Can't edit this National Object" H 2 Q
I $P($G(^GMT(142.5,HSOBJ,0)),U,17)'=DUZ,'$D(^XUSEC("GMTSMGR",DUZ)) W !,"Can't edit this HS Object: Only the owner or the HS Manager can edit this HS Object" H 2 Q
W !,"***WARNING*** By changing the HS Type this will change the output data."
S DIR(0)="YA0"
S DIR("A")="Continue? "
S DIR("B")="NO"
S DIR("?")="Enter Y or N. For detailed help type ??"
D ^DIR
I $D(DIROUT) S DTOUT=1
I $D(DTOUT)!($D(DUOUT)) Q
S YESNO=$E(Y(0))
I YESNO="Y" D
.S DIC=142,DIC(0)="AEMQ",DIC("S")="I Y'<1",DIC("A")="Enter HEALTH SUMMARY TYPE: "
.W ! D ^DIC
.I Y=-1 K DIC Q
.S HSIEN=+Y
.S DIE="^GMT(142.5,",DA=IEN,DR=".03///^S X=HSIEN" D ^DIE
.D CLEAN^VALM10
.D INIT
Q
;
CREATEHS ;
N POP
D FULL^VALM1
D TYPE^GMTSOBJ(HSTYNAM)
W ! S DIR(0)="E" D ^DIR
D CLEAN^VALM10
D INIT
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
XQORM ;
S XQORM("A")="Select Action: "
Q
;
EXIT ; -- exit code
Q
;
EXPND ; -- expand code
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUHSOLM 4690 printed Jan 18, 2025@03:42:55 Page 2
TIUHSOLM ;;SLC/AJB,AGP Display Health Summary Object for TIU Objects;27-MAR-2009
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**135,249**;Jun 20, 1997;Build 48
+2 ;
EN(IEN,TIUIEN) ; -- main entry point for TIUHS OBJ DISPLAY
+1 DO EN^VALM("TIUHS OBJ DISPLAY")
+2 QUIT
+3 ;
HDR ; -- header code
+1 NEW CENTER,HEADER,TIUNAM,HSOBJNOD,TITLE,VALHDR,VALMSG
+2 ;S HSOBJNOD=$G(^GMT(142.5,IEN,0))
+3 SET TIUNAM=$PIECE($GET(^TIU(8925.1,TIUIEN,0)),U)
+4 SET TITLE="Detailed Display for "_TIUNAM
+5 SET CENTER=(IOM-$LENGTH(TITLE))/2
+6 SET HEADER=$$SETSTR^VALM1(TITLE,"",CENTER,$LENGTH(TITLE))
+7 SET VALMHDR(1)=HEADER
+8 SET VALMSG="?? More Actions"
+9 DO XQORM
+10 QUIT
+11 ;
INIT ; -- init variables and list array
+1 NEW LINE,OBJ,OBJDISP,OBJECT,VAL,VALUE
+2 SET LINE=0
+3 ;hs object heading
+4 DO EXTRACT^GMTSOBJ(IEN,.OBJ)
+5 SET HSTYNAM=$GET(OBJ(IEN,.03,"E"))
+6 SET VALUE=$JUSTIFY("HS Object",25)_": "_$GET(OBJ(IEN,.01,"E"))
SET LINE=LINE+1
+7 DO SET^VALM10(LINE,VALUE)
+8 IF $GET(OBJ(IEN,.02,"E"))'=""
Begin DoDot:1
+9 SET VALUE=$JUSTIFY($GET(OBJ(IEN,.02,"PROMPT")),25)_": "_$GET(OBJ(IEN,.02,"E"))
+10 SET LINE=LINE+1
+11 DO SET^VALM10(LINE,VALUE)
End DoDot:1
+12 SET VALUE=$JUSTIFY($GET(OBJ(IEN,.03,"PROMPT")),25)_": "_HSTYNAM
SET LINE=LINE+1
+13 DO SET^VALM10(LINE,VALUE)
+14 SET VALUE=$JUSTIFY($GET(OBJ(IEN,.04,"PROMPT")),25)_": "_$GET(OBJ(IEN,.04,"E"))
SET LINE=LINE+1
+15 DO SET^VALM10(LINE,VALUE)
+16 SET VALUE=$JUSTIFY($GET(OBJ(IEN,.17,"PROMPT")),25)_": "_$GET(OBJ(IEN,.17,"E"))
+17 SET LINE=LINE+1
+18 DO SET^VALM10(LINE,VALUE)
+19 SET VALUE=" "
SET LINE=LINE+1
DO SET^VALM10(LINE,VALUE)
+20 SET OBJDISP="HS Object"
SET CENTER=(IOM-$LENGTH(OBJDISP))/2
+21 SET VALUE=$$SETSTR^VALM1(OBJDISP,"",CENTER,$LENGTH(OBJDISP))
+22 SET LINE=LINE+1
DO SET^VALM10(LINE,VALUE)
+23 SET VALUE=" "
SET LINE=LINE+1
DO SET^VALM10(LINE,VALUE)
+24 SET VALUE=$JUSTIFY($GET(OBJ(IEN,.07,"PROMPT")),29)_": "_$GET(OBJ(IEN,.07,"E"))
+25 SET VAL=$$LJ^XLFSTR(VALUE,40)
SET VALUE=VAL_$JUSTIFY($GET(OBJ(IEN,.09,"PROMPT")),28)_": "_$GET(OBJ(IEN,.09,"E"))
+26 SET LINE=LINE+1
+27 DO SET^VALM10(LINE,VALUE)
+28 SET VALUE=$JUSTIFY($GET(OBJ(IEN,.08,"PROMPT")),29)_": "_$GET(OBJ(IEN,.08,"E"))
+29 SET VAL=$$LJ^XLFSTR(VALUE,40)
SET VALUE=VAL_$JUSTIFY($GET(OBJ(IEN,.1,"PROMPT")),28)_": "_$GET(OBJ(IEN,.1,"E"))
+30 SET LINE=LINE+1
+31 DO SET^VALM10(LINE,VALUE)
+32 SET VALUE=$JUSTIFY("Customized Header",29)_": "_$GET(OBJ(IEN,.06,"E"))
+33 SET VAL=$$LJ^XLFSTR(VALUE,40)
SET VALUE=VAL_$JUSTIFY($GET(OBJ(IEN,.09,"PROMPT")),28)_": "_$GET(OBJ(IEN,.09,"E"))
+34 SET LINE=LINE+1
+35 DO SET^VALM10(LINE,VALUE)
+36 SET VALUE=$JUSTIFY($GET(OBJ(IEN,.05,"PROMPT")),29)_": "_$GET(OBJ(IEN,.05,"E"))
+37 SET VAL=$$LJ^XLFSTR(VALUE,40)
SET VALUE=VAL_$JUSTIFY($GET(OBJ(IEN,.12,"PROMPT")),28)_": "_$GET(OBJ(IEN,.12,"E"))
+38 SET LINE=LINE+1
+39 DO SET^VALM10(LINE,VALUE)
+40 SET VALUE=$JUSTIFY($GET(OBJ(IEN,.16,"PROMPT")),29)_": "_$GET(OBJ(IEN,.16,"E"))
+41 SET VAL=$$LJ^XLFSTR(VALUE,40)
SET VALUE=VAL_$JUSTIFY($GET(OBJ(IEN,.14,"PROMPT")),28)_": "_$GET(OBJ(IEN,.14,"E"))
+42 SET LINE=LINE+1
+43 DO SET^VALM10(LINE,VALUE)
+44 SET VALUE=$JUSTIFY($GET(OBJ(IEN,.2,"PROMPT")),29)_": "_$GET(OBJ(IEN,.2,"E"))
+45 SET VAL=$$LJ^XLFSTR(VALUE,40)
SET VALUE=VAL_$JUSTIFY($GET(OBJ(IEN,.13,"PROMPT")),28)_": "_$GET(OBJ(IEN,.13,"E"))
+46 SET LINE=LINE+1
+47 DO SET^VALM10(LINE,VALUE)
+48 SET VALUE=$$RJ^XLFSTR("Blank Line After Header",68)_": "_$GET(OBJ(IEN,.15,"E"))
+49 SET LINE=LINE+1
+50 DO SET^VALM10(LINE,VALUE)
+51 SET VALUE=$$RJ^XLFSTR("Overwrite No Data",19)_": "_$GET(OBJ(IEN,2,"E"))
+52 SET LINE=LINE+1
+53 DO SET^VALM10(LINE,VALUE)
+54 SET VALMCNT=LINE
+55 QUIT
+56 ;
EHSO ;
+1 NEW HSOBNAM,VALUE
+2 DO FULL^VALM1
+3 IF $PIECE($GET(^GMT(142.5,HSOBJ,0)),U,20)=1
WRITE !,"Can't edit this HS Object: Only the owner can edit this HS Object"
HANG 2
QUIT
+4 IF $PIECE($GET(^GMT(142.5,HSOBJ,0)),U,17)'=DUZ
IF '$DATA(^XUSEC("GMTSMGR",DUZ))
WRITE !,"Can't edit this HS Object: Only the owner or the HS Manager can edit this HS Object"
HANG 2
QUIT
+5 SET HSOBNAM=$PIECE($GET(^GMT(142.5,IEN,0)),U)
+6 SET VALUE=$$CRE^GMTSOBJ(HSOBNAM)
+7 DO CLEAN^VALM10
+8 DO INIT
+9 QUIT
+10 ;
CHST ;
+1 NEW DA,DIC,DIE,DIR,DIROUT,DR,DTOUT,DUOUT,HSIEN,POP,TEXT,X,Y,YESNO
+2 DO FULL^VALM1
+3 IF $PIECE($GET(^GMT(142.5,HSOBJ,0)),U,20)=1
WRITE !,"Can't edit this National Object"
HANG 2
QUIT
+4 IF $PIECE($GET(^GMT(142.5,HSOBJ,0)),U,17)'=DUZ
IF '$DATA(^XUSEC("GMTSMGR",DUZ))
WRITE !,"Can't edit this HS Object: Only the owner or the HS Manager can edit this HS Object"
HANG 2
QUIT
+5 WRITE !,"***WARNING*** By changing the HS Type this will change the output data."
+6 SET DIR(0)="YA0"
+7 SET DIR("A")="Continue? "
+8 SET DIR("B")="NO"
+9 SET DIR("?")="Enter Y or N. For detailed help type ??"
+10 DO ^DIR
+11 IF $DATA(DIROUT)
SET DTOUT=1
+12 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+13 SET YESNO=$EXTRACT(Y(0))
+14 IF YESNO="Y"
Begin DoDot:1
+15 SET DIC=142
SET DIC(0)="AEMQ"
SET DIC("S")="I Y'<1"
SET DIC("A")="Enter HEALTH SUMMARY TYPE: "
+16 WRITE !
DO ^DIC
+17 IF Y=-1
KILL DIC
QUIT
+18 SET HSIEN=+Y
+19 SET DIE="^GMT(142.5,"
SET DA=IEN
SET DR=".03///^S X=HSIEN"
DO ^DIE
+20 DO CLEAN^VALM10
+21 DO INIT
End DoDot:1
+22 QUIT
+23 ;
CREATEHS ;
+1 NEW POP
+2 DO FULL^VALM1
+3 DO TYPE^GMTSOBJ(HSTYNAM)
+4 WRITE !
SET DIR(0)="E"
DO ^DIR
+5 DO CLEAN^VALM10
+6 DO INIT
+7 QUIT
+8 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
XQORM ;
+1 SET XQORM("A")="Select Action: "
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 QUIT
+2 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
