Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIUHSOLM

TIUHSOLM.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. EN(IEN,TIUIEN) ; -- main entry point for TIUHS OBJ DISPLAY
  1. D EN^VALM("TIUHS OBJ DISPLAY")
  1. Q
  1. ;
  1. HDR ; -- header code
  1. N CENTER,HEADER,TIUNAM,HSOBJNOD,TITLE,VALHDR,VALMSG
  1. ;S HSOBJNOD=$G(^GMT(142.5,IEN,0))
  1. S TIUNAM=$P($G(^TIU(8925.1,TIUIEN,0)),U)
  1. S TITLE="Detailed Display for "_TIUNAM
  1. S CENTER=(IOM-$L(TITLE))/2
  1. S HEADER=$$SETSTR^VALM1(TITLE,"",CENTER,$L(TITLE))
  1. S VALMHDR(1)=HEADER
  1. S VALMSG="?? More Actions"
  1. D XQORM
  1. Q
  1. ;
  1. INIT ; -- init variables and list array
  1. N LINE,OBJ,OBJDISP,OBJECT,VAL,VALUE
  1. S LINE=0
  1. ;hs object heading
  1. D EXTRACT^GMTSOBJ(IEN,.OBJ)
  1. S HSTYNAM=$G(OBJ(IEN,.03,"E"))
  1. S VALUE=$J("HS Object",25)_": "_$G(OBJ(IEN,.01,"E")),LINE=LINE+1
  1. D SET^VALM10(LINE,VALUE)
  1. I $G(OBJ(IEN,.02,"E"))'="" D
  1. . S VALUE=$J($G(OBJ(IEN,.02,"PROMPT")),25)_": "_$G(OBJ(IEN,.02,"E"))
  1. . S LINE=LINE+1
  1. . D SET^VALM10(LINE,VALUE)
  1. S VALUE=$J($G(OBJ(IEN,.03,"PROMPT")),25)_": "_HSTYNAM,LINE=LINE+1
  1. D SET^VALM10(LINE,VALUE)
  1. S VALUE=$J($G(OBJ(IEN,.04,"PROMPT")),25)_": "_$G(OBJ(IEN,.04,"E")),LINE=LINE+1
  1. D SET^VALM10(LINE,VALUE)
  1. S VALUE=$J($G(OBJ(IEN,.17,"PROMPT")),25)_": "_$G(OBJ(IEN,.17,"E"))
  1. S LINE=LINE+1
  1. D SET^VALM10(LINE,VALUE)
  1. S VALUE=" ",LINE=LINE+1 D SET^VALM10(LINE,VALUE)
  1. S OBJDISP="HS Object",CENTER=(IOM-$L(OBJDISP))/2
  1. S VALUE=$$SETSTR^VALM1(OBJDISP,"",CENTER,$L(OBJDISP))
  1. S LINE=LINE+1 D SET^VALM10(LINE,VALUE)
  1. S VALUE=" ",LINE=LINE+1 D SET^VALM10(LINE,VALUE)
  1. S VALUE=$J($G(OBJ(IEN,.07,"PROMPT")),29)_": "_$G(OBJ(IEN,.07,"E"))
  1. S VAL=$$LJ^XLFSTR(VALUE,40) S VALUE=VAL_$J($G(OBJ(IEN,.09,"PROMPT")),28)_": "_$G(OBJ(IEN,.09,"E"))
  1. S LINE=LINE+1
  1. D SET^VALM10(LINE,VALUE)
  1. S VALUE=$J($G(OBJ(IEN,.08,"PROMPT")),29)_": "_$G(OBJ(IEN,.08,"E"))
  1. S VAL=$$LJ^XLFSTR(VALUE,40) S VALUE=VAL_$J($G(OBJ(IEN,.1,"PROMPT")),28)_": "_$G(OBJ(IEN,.1,"E"))
  1. S LINE=LINE+1
  1. D SET^VALM10(LINE,VALUE)
  1. S VALUE=$J("Customized Header",29)_": "_$G(OBJ(IEN,.06,"E"))
  1. S VAL=$$LJ^XLFSTR(VALUE,40) S VALUE=VAL_$J($G(OBJ(IEN,.09,"PROMPT")),28)_": "_$G(OBJ(IEN,.09,"E"))
  1. S LINE=LINE+1
  1. D SET^VALM10(LINE,VALUE)
  1. S VALUE=$J($G(OBJ(IEN,.05,"PROMPT")),29)_": "_$G(OBJ(IEN,.05,"E"))
  1. S VAL=$$LJ^XLFSTR(VALUE,40) S VALUE=VAL_$J($G(OBJ(IEN,.12,"PROMPT")),28)_": "_$G(OBJ(IEN,.12,"E"))
  1. S LINE=LINE+1
  1. D SET^VALM10(LINE,VALUE)
  1. S VALUE=$J($G(OBJ(IEN,.16,"PROMPT")),29)_": "_$G(OBJ(IEN,.16,"E"))
  1. S VAL=$$LJ^XLFSTR(VALUE,40) S VALUE=VAL_$J($G(OBJ(IEN,.14,"PROMPT")),28)_": "_$G(OBJ(IEN,.14,"E"))
  1. S LINE=LINE+1
  1. D SET^VALM10(LINE,VALUE)
  1. S VALUE=$J($G(OBJ(IEN,.2,"PROMPT")),29)_": "_$G(OBJ(IEN,.2,"E"))
  1. S VAL=$$LJ^XLFSTR(VALUE,40) S VALUE=VAL_$J($G(OBJ(IEN,.13,"PROMPT")),28)_": "_$G(OBJ(IEN,.13,"E"))
  1. S LINE=LINE+1
  1. D SET^VALM10(LINE,VALUE)
  1. S VALUE=$$RJ^XLFSTR("Blank Line After Header",68)_": "_$G(OBJ(IEN,.15,"E"))
  1. S LINE=LINE+1
  1. D SET^VALM10(LINE,VALUE)
  1. S VALUE=$$RJ^XLFSTR("Overwrite No Data",19)_": "_$G(OBJ(IEN,2,"E"))
  1. S LINE=LINE+1
  1. D SET^VALM10(LINE,VALUE)
  1. S VALMCNT=LINE
  1. Q
  1. ;
  1. EHSO ;
  1. N HSOBNAM,VALUE
  1. D FULL^VALM1
  1. 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
  1. 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
  1. S HSOBNAM=$P($G(^GMT(142.5,IEN,0)),U)
  1. S VALUE=$$CRE^GMTSOBJ(HSOBNAM)
  1. D CLEAN^VALM10
  1. D INIT
  1. Q
  1. ;
  1. CHST ;
  1. N DA,DIC,DIE,DIR,DIROUT,DR,DTOUT,DUOUT,HSIEN,POP,TEXT,X,Y,YESNO
  1. D FULL^VALM1
  1. I $P($G(^GMT(142.5,HSOBJ,0)),U,20)=1 W !,"Can't edit this National Object" H 2 Q
  1. 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
  1. W !,"***WARNING*** By changing the HS Type this will change the output data."
  1. S DIR(0)="YA0"
  1. S DIR("A")="Continue? "
  1. S DIR("B")="NO"
  1. S DIR("?")="Enter Y or N. For detailed help type ??"
  1. D ^DIR
  1. I $D(DIROUT) S DTOUT=1
  1. I $D(DTOUT)!($D(DUOUT)) Q
  1. S YESNO=$E(Y(0))
  1. I YESNO="Y" D
  1. .S DIC=142,DIC(0)="AEMQ",DIC("S")="I Y'<1",DIC("A")="Enter HEALTH SUMMARY TYPE: "
  1. .W ! D ^DIC
  1. .I Y=-1 K DIC Q
  1. .S HSIEN=+Y
  1. .S DIE="^GMT(142.5,",DA=IEN,DR=".03///^S X=HSIEN" D ^DIE
  1. .D CLEAN^VALM10
  1. .D INIT
  1. Q
  1. ;
  1. CREATEHS ;
  1. N POP
  1. D FULL^VALM1
  1. D TYPE^GMTSOBJ(HSTYNAM)
  1. W ! S DIR(0)="E" D ^DIR
  1. D CLEAN^VALM10
  1. D INIT
  1. Q
  1. ;
  1. HELP ; -- help code
  1. S X="?" D DISP^XQORM1 W !!
  1. Q
  1. ;
  1. XQORM ;
  1. S XQORM("A")="Select Action: "
  1. Q
  1. ;
  1. EXIT ; -- exit code
  1. Q
  1. ;
  1. EXPND ; -- expand code
  1. Q
  1. ;