TIUHSV ;;SLC/AJB,AGP Edit Menu for TIUHS Routines;06/24/09
;;1.0;TEXT INTEGRATION UTILITIES;**135,249**;Jun 20, 1997;Build 48
EN(IEN) ; -- main entry point for TIUHSLSV
N MSG
K ^TMP("VALMAR",$J)
D EN^VALM("TIUHSLSV")
Q
;
HDR ; -- header code
N CENTER,HEADER,OBJNAME,OBJNODE,TITLE,VALMHDR
S OBJNODE=^TIU(8925.1,IEN,0)
S OBJNAME=$P($G(OBJNODE),U)
S TITLE="Detailed Display/Edit for "_OBJNAME
S CENTER=(IOM-$L(TITLE))/2
S HEADER=$$SETSTR^VALM1(TITLE,"",CENTER,$L(TITLE))
S VALMHDR(1)=HEADER
Q
;
INIT ; -- init variables and list array
N ANS,CNT,DISP,HSONAME,HSTNAME,HSTYPE,LINE
N NUM,OBJMETD,OBJNAME,OBJNODE,OBJSTAT,OWNER
S OBJNODE=^TIU(8925.1,IEN,0)
S OBJSTAT=$S($P($G(OBJNODE),U,7)=11:"ACTIVE",$P($G(OBJNODE),U,7)=13:"INACTIVE")
S OBJNAME=$P($G(OBJNODE),U)
S OBJMETD=^TIU(8925.1,IEN,9)
S OWNER=$$GET1^DIQ(200,$P($G(OBJNODE),U,5),.01)
I OWNER="" S OWNER="<UNKNOWN> OR 0"
S HSOBJ=$P($P($G(OBJMETD),",",2),")")
I $G(HSOBJ)'=""&($D(^GMT(142.5,HSOBJ))>0) D
. S HSONAME=$$GET1^DIQ(142.5,HSOBJ,.01)
. S HSTYPE=$P($G(^GMT(142.5,HSOBJ,0)),U,3)
. I $G(HSTYPE)'=""&($D(^GMT(142,HSTYPE))>0) S HSTNAME=$$GET1^DIQ(142,HSTYPE,.01)
. E S HSTNAME="Invalid Health Summary Type IEN"
E S HSONAME="Invalid Health Summary Object IEN",HSTNAME="Invalid Health Summary Type IEN"
S HSTYPE=$P($G(^GMT(142.5,HSOBJ,0)),U,3)
;
;
S LINE=1
S DISP=""
D SET^VALM10(LINE,DISP)
F CNT=1:1:6 D
.S LINE=LINE+1
.S DISP=$P($T(OUTPUT+CNT),";;",2)
.S ANS=$S(CNT=1:OBJNAME,CNT=2:OWNER,CNT=3:OBJSTAT,CNT=4:HSONAME,CNT=5:HSTNAME,CNT=6:OBJMETD)
.S DISP=($J(DISP,25))_" "_ANS
.D SET^VALM10(LINE,DISP)
S VALMCNT=LINE
Q
OUTPUT ;
;;TIU Object Name:
;;Owner:
;;Status:
;;HS Object:
;;HS Type:
;;Technical Field:
;
TIUN ;
D FULL^VALM1
D EDIT^TIUHSOBJ(IEN)
D CLEAN^VALM10
D INIT
Q
;
HSEDIT ;
N DIC,DIR,DIR,DIROUT,DTOUT,DUOUT,HIEN,POP,TEXT,X,Y,YESNO
D FULL^VALM1
I DUZ'=$P($G(^TIU(8925.1,IEN,0)),U,5) W !,"Can't edit this TIU Object: Only the owner can edit this TIU Object" H 2 Q
W !,"***WARNING***",!,"Changing the HS Object will change the output data and may change the HS Type."
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.5,DIC(0)="AEMQ",DIC("S")="I Y'<1",DIC("A")="Enter HEALTH SUMMARY OBJECT: "
.W ! D ^DIC
.I Y=-1 K DIC Q
.S HIEN=+Y
.S ^TIU(8925.1,IEN,9)="S X=$$TIU^GMTSOBJ(DFN,"_HIEN_")"
D CLEAN^VALM10
D INIT
Q
;
CHHST ;
N DA,DIC,DIE,DIR,DIROUT,DR,DTOUT,DUOUT,HSIEN,POP,TEXT,X,Y,YESNO
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 can edit this HS object." H 2 Q
W !,"***WARNING*** Changing the HS Type 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=HSOBJ,DR=".03///^S X=HSIEN" D ^DIE
D CLEAN^VALM10
D INIT
Q
;
HSOBJ ;
D FULL^VALM1
N HSTYNAM,YESNO
S YESNO="Y"
I $D(^GMT(142.5,HSOBJ,0))=0 D
. W !,"No HS Object found. Create new HS Object now?"
. S DIR(0)="YA0"
. 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)) S YESNO="N" Q
. S YESNO=$E(Y(0))
. I YESNO="Y" S HSOBJ=$$CRE^GMTSOBJ()
I $G(YESNO)="Y"&(HSOBJ>0) D
. S ^TIU(8925.1,IEN,9)="S X=$$TIU^GMTSOBJ(DFN,"_HSOBJ_")"
. D EN^TIUHSOLM(HSOBJ,IEN)
D CLEAN^VALM10
D INIT
Q
;
HELP ; -- help code
N X
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
Q
;
EXPND ; -- expand code
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUHSV 4075 printed Oct 16, 2024@18:42:24 Page 2
TIUHSV ;;SLC/AJB,AGP Edit Menu for TIUHS Routines;06/24/09
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**135,249**;Jun 20, 1997;Build 48
EN(IEN) ; -- main entry point for TIUHSLSV
+1 NEW MSG
+2 KILL ^TMP("VALMAR",$JOB)
+3 DO EN^VALM("TIUHSLSV")
+4 QUIT
+5 ;
HDR ; -- header code
+1 NEW CENTER,HEADER,OBJNAME,OBJNODE,TITLE,VALMHDR
+2 SET OBJNODE=^TIU(8925.1,IEN,0)
+3 SET OBJNAME=$PIECE($GET(OBJNODE),U)
+4 SET TITLE="Detailed Display/Edit for "_OBJNAME
+5 SET CENTER=(IOM-$LENGTH(TITLE))/2
+6 SET HEADER=$$SETSTR^VALM1(TITLE,"",CENTER,$LENGTH(TITLE))
+7 SET VALMHDR(1)=HEADER
+8 QUIT
+9 ;
INIT ; -- init variables and list array
+1 NEW ANS,CNT,DISP,HSONAME,HSTNAME,HSTYPE,LINE
+2 NEW NUM,OBJMETD,OBJNAME,OBJNODE,OBJSTAT,OWNER
+3 SET OBJNODE=^TIU(8925.1,IEN,0)
+4 SET OBJSTAT=$SELECT($PIECE($GET(OBJNODE),U,7)=11:"ACTIVE",$PIECE($GET(OBJNODE),U,7)=13:"INACTIVE")
+5 SET OBJNAME=$PIECE($GET(OBJNODE),U)
+6 SET OBJMETD=^TIU(8925.1,IEN,9)
+7 SET OWNER=$$GET1^DIQ(200,$PIECE($GET(OBJNODE),U,5),.01)
+8 IF OWNER=""
SET OWNER="<UNKNOWN> OR 0"
+9 SET HSOBJ=$PIECE($PIECE($GET(OBJMETD),",",2),")")
+10 IF $GET(HSOBJ)'=""&($DATA(^GMT(142.5,HSOBJ))>0)
Begin DoDot:1
+11 SET HSONAME=$$GET1^DIQ(142.5,HSOBJ,.01)
+12 SET HSTYPE=$PIECE($GET(^GMT(142.5,HSOBJ,0)),U,3)
+13 IF $GET(HSTYPE)'=""&($DATA(^GMT(142,HSTYPE))>0)
SET HSTNAME=$$GET1^DIQ(142,HSTYPE,.01)
+14 IF '$TEST
SET HSTNAME="Invalid Health Summary Type IEN"
End DoDot:1
+15 IF '$TEST
SET HSONAME="Invalid Health Summary Object IEN"
SET HSTNAME="Invalid Health Summary Type IEN"
+16 SET HSTYPE=$PIECE($GET(^GMT(142.5,HSOBJ,0)),U,3)
+17 ;
+18 ;
+19 SET LINE=1
+20 SET DISP=""
+21 DO SET^VALM10(LINE,DISP)
+22 FOR CNT=1:1:6
Begin DoDot:1
+23 SET LINE=LINE+1
+24 SET DISP=$PIECE($TEXT(OUTPUT+CNT),";;",2)
+25 SET ANS=$SELECT(CNT=1:OBJNAME,CNT=2:OWNER,CNT=3:OBJSTAT,CNT=4:HSONAME,CNT=5:HSTNAME,CNT=6:OBJMETD)
+26 SET DISP=($JUSTIFY(DISP,25))_" "_ANS
+27 DO SET^VALM10(LINE,DISP)
End DoDot:1
+28 SET VALMCNT=LINE
+29 QUIT
OUTPUT ;
+1 ;;TIU Object Name:
+2 ;;Owner:
+3 ;;Status:
+4 ;;HS Object:
+5 ;;HS Type:
+6 ;;Technical Field:
+7 ;
TIUN ;
+1 DO FULL^VALM1
+2 DO EDIT^TIUHSOBJ(IEN)
+3 DO CLEAN^VALM10
+4 DO INIT
+5 QUIT
+6 ;
HSEDIT ;
+1 NEW DIC,DIR,DIR,DIROUT,DTOUT,DUOUT,HIEN,POP,TEXT,X,Y,YESNO
+2 DO FULL^VALM1
+3 IF DUZ'=$PIECE($GET(^TIU(8925.1,IEN,0)),U,5)
WRITE !,"Can't edit this TIU Object: Only the owner can edit this TIU Object"
HANG 2
QUIT
+4 WRITE !,"***WARNING***",!,"Changing the HS Object will change the output data and may change the HS Type."
+5 SET DIR(0)="YA0"
+6 SET DIR("A")="Continue? "
+7 SET DIR("B")="NO"
+8 SET DIR("?")="Enter Y or N. For detailed help type ??"
+9 DO ^DIR
+10 IF $DATA(DIROUT)
SET DTOUT=1
+11 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+12 SET YESNO=$EXTRACT(Y(0))
+13 IF YESNO="Y"
Begin DoDot:1
+14 SET DIC=142.5
SET DIC(0)="AEMQ"
SET DIC("S")="I Y'<1"
SET DIC("A")="Enter HEALTH SUMMARY OBJECT: "
+15 WRITE !
DO ^DIC
+16 IF Y=-1
KILL DIC
QUIT
+17 SET HIEN=+Y
+18 SET ^TIU(8925.1,IEN,9)="S X=$$TIU^GMTSOBJ(DFN,"_HIEN_")"
End DoDot:1
+19 DO CLEAN^VALM10
+20 DO INIT
+21 QUIT
+22 ;
CHHST ;
+1 NEW DA,DIC,DIE,DIR,DIROUT,DR,DTOUT,DUOUT,HSIEN,POP,TEXT,X,Y,YESNO
+2 IF $PIECE($GET(^GMT(142.5,HSOBJ,0)),U,20)=1
WRITE !,"Can't edit this National Object."
HANG 2
QUIT
+3 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 can edit this HS object."
HANG 2
QUIT
+4 WRITE !,"***WARNING*** Changing the HS Type will change the output data."
+5 SET DIR(0)="YA0"
+6 SET DIR("A")="Continue? "
+7 SET DIR("B")="NO"
+8 SET DIR("?")="Enter Y or N. For detailed help type ??"
+9 DO ^DIR
+10 IF $DATA(DIROUT)
SET DTOUT=1
+11 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+12 SET YESNO=$EXTRACT(Y(0))
+13 IF YESNO="Y"
Begin DoDot:1
+14 SET DIC=142
SET DIC(0)="AEMQ"
SET DIC("S")="I Y'<1"
SET DIC("A")="Enter HEALTH SUMMARY TYPE: "
+15 WRITE !
DO ^DIC
+16 IF Y=-1
KILL DIC
QUIT
+17 SET HSIEN=+Y
+18 SET DIE="^GMT(142.5,"
SET DA=HSOBJ
SET DR=".03///^S X=HSIEN"
DO ^DIE
End DoDot:1
+19 DO CLEAN^VALM10
+20 DO INIT
+21 QUIT
+22 ;
HSOBJ ;
+1 DO FULL^VALM1
+2 NEW HSTYNAM,YESNO
+3 SET YESNO="Y"
+4 IF $DATA(^GMT(142.5,HSOBJ,0))=0
Begin DoDot:1
+5 WRITE !,"No HS Object found. Create new HS Object now?"
+6 SET DIR(0)="YA0"
+7 SET DIR("B")="NO"
+8 SET DIR("?")="Enter Y or N. For detailed help type ??"
+9 DO ^DIR
+10 IF $DATA(DIROUT)
SET DTOUT=1
+11 IF $DATA(DTOUT)!($DATA(DUOUT))
SET YESNO="N"
QUIT
+12 SET YESNO=$EXTRACT(Y(0))
+13 IF YESNO="Y"
SET HSOBJ=$$CRE^GMTSOBJ()
End DoDot:1
+14 IF $GET(YESNO)="Y"&(HSOBJ>0)
Begin DoDot:1
+15 SET ^TIU(8925.1,IEN,9)="S X=$$TIU^GMTSOBJ(DFN,"_HSOBJ_")"
+16 DO EN^TIUHSOLM(HSOBJ,IEN)
End DoDot:1
+17 DO CLEAN^VALM10
+18 DO INIT
+19 QUIT
+20 ;
HELP ; -- help code
+1 NEW X
+2 SET X="?"
DO DISP^XQORM1
WRITE !!
+3 QUIT
+4 ;
EXIT ; -- exit code
+1 QUIT
+2 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
