- 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 ;