TIU370P ; NA/AJB - PERSIAN GULF UPDATE;Nov 06, 2024@12:59:03
;;1.0;TEXT INTEGRATION UTILITIES;**370**;Jun 20, 1997;Build 14
;
; Reference to FIND1^DIC in ICR #2051
; Reference to BMES^XPDUTL in ICR #10141
; Reference to MES^XPDUTL in ICR #10141
;
Q
DEL ; testing use only
N DETAILS,ENTRY
F ENTRY=1:1 S DETAILS=$P($T(ENTRIES+ENTRY),";",2,4) Q:DETAILS="" D
. N DA,DIK,NAME,PARENT,TYPE,X,Y
. S NAME=$P(DETAILS,";"),DA=$$LU(8925.1,NAME,"X"),DIK="^TIU(8925.1,",PARENT=$$LU(8925.1,"PROGRESS NOTES","X"),TYPE=$P(DETAILS,";",3) Q:'DA
. D ^DIK Q:TYPE'="DC"
. K ^TIU(8925.1,PARENT,10,"C",NAME)
. K ^TIU(8925.1,PARENT,10,$O(^TIU(8925.1,PARENT,10,"B",DA,0)))
. K ^TIU(8925.1,PARENT,10,"B",DA)
Q
ENTRIES ;name;print name;type;m-code
;VA-PERSIAN GULF STATUS;VA-Persian Gulf Status;OBJ
;VA-GULFVET QUESTIONNAIRE;;DC
;GULFVET QUESTIONNAIRE;GulfVET Questionnaire;DOC
;
LU(FILE,NAME,FLAGS,SCREEN,INDEXES) ;
Q $$FIND1^DIC(FILE,"",$G(FLAGS),NAME,$G(INDEXES),$G(SCREEN))
POST ; post-install
N DETAILS,ENTRY
F ENTRY=1:1 S DETAILS=$P($T(ENTRIES+ENTRY),";",2,4) Q:DETAILS="" D
. N DA,NAME,PNAME,TYPE,X,Y
. S NAME=$P(DETAILS,";"),PNAME=$P(DETAILS,";",2),TYPE=$P(DETAILS,";",3)
. I TYPE="OBJ" S DA=$$CROBJ^TIUCROBJ(NAME,"",PNAME,"S X=$$PGULF^TIUMSER(DFN)")
. I TYPE="DC" S DA=$$CRDD^TIUCRDD(NAME,TYPE,11,"PROGRESS NOTES")
. I TYPE="DOC" D S DA=$$CRDD^TIUCRDD(NAME,TYPE,11,"VA-GULFVET QUESTIONNAIRE","PRIMARY CARE NOTE")
. . ; remove previously linked entries
. . D UNLINK
. Q:PNAME=""
. N TIU,ERROR
. S TIU(8925.1,$$LU(8925.1,NAME,"X")_",",.03)=PNAME
. D UPDATE^DIE("","TIU","","ERROR")
Q
UNLINK ;
N NAME S NAME="GULFVET QUESTIONNAIRE"
N DIALOG S DIALOG=$$LU(801.41,"VA-GULFVET QUESTIONNAIRE","X","I $P(^(0),U,4)=""R""") Q:'DIALOG
N OUT D FIND^DIC(8927,"","@;.01I","P",NAME,"","","","","OUT")
N PARENT S PARENT=$$LU(8927,"Document Titles","X") Q:'PARENT
N NUM S NUM=0 F S NUM=$O(OUT("DILIST",NUM)) Q:'NUM D
. N IEN S IEN=+OUT("DILIST",NUM,0)
. N NODE S NODE=$G(^TIU(8927,IEN,0))
. Q:$P(NODE,U,6)>0 ; personal owner
. Q:$P(NODE,U,15)'=DIALOG ; reminder dialog
. N NUM S NUM=0 F S NUM=$O(^TIU(8927,PARENT,10,NUM)) Q:'NUM D
. . Q:$P($G(^TIU(8927,PARENT,10,NUM,0)),U,2)'=IEN
. . N DA,DIK S DA(1)=PARENT,DA=NUM,DIK="^TIU(8927,"_DA(1)_",10," D ^DIK ; remove entries from parent first
. N DA,DIK S DA=IEN,DIK="^TIU(8927," D ^DIK ; remove entry
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIU370P 2426 printed Aug 26, 2025@22:54:36 Page 2
TIU370P ; NA/AJB - PERSIAN GULF UPDATE;Nov 06, 2024@12:59:03
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**370**;Jun 20, 1997;Build 14
+2 ;
+3 ; Reference to FIND1^DIC in ICR #2051
+4 ; Reference to BMES^XPDUTL in ICR #10141
+5 ; Reference to MES^XPDUTL in ICR #10141
+6 ;
+7 QUIT
DEL ; testing use only
+1 NEW DETAILS,ENTRY
+2 FOR ENTRY=1:1
SET DETAILS=$PIECE($TEXT(ENTRIES+ENTRY),";",2,4)
if DETAILS=""
QUIT
Begin DoDot:1
+3 NEW DA,DIK,NAME,PARENT,TYPE,X,Y
+4 SET NAME=$PIECE(DETAILS,";")
SET DA=$$LU(8925.1,NAME,"X")
SET DIK="^TIU(8925.1,"
SET PARENT=$$LU(8925.1,"PROGRESS NOTES","X")
SET TYPE=$PIECE(DETAILS,";",3)
if 'DA
QUIT
+5 DO ^DIK
if TYPE'="DC"
QUIT
+6 KILL ^TIU(8925.1,PARENT,10,"C",NAME)
+7 KILL ^TIU(8925.1,PARENT,10,$ORDER(^TIU(8925.1,PARENT,10,"B",DA,0)))
+8 KILL ^TIU(8925.1,PARENT,10,"B",DA)
End DoDot:1
+9 QUIT
ENTRIES ;name;print name;type;m-code
+1 ;VA-PERSIAN GULF STATUS;VA-Persian Gulf Status;OBJ
+2 ;VA-GULFVET QUESTIONNAIRE;;DC
+3 ;GULFVET QUESTIONNAIRE;GulfVET Questionnaire;DOC
+4 ;
LU(FILE,NAME,FLAGS,SCREEN,INDEXES) ;
+1 QUIT $$FIND1^DIC(FILE,"",$GET(FLAGS),NAME,$GET(INDEXES),$GET(SCREEN))
POST ; post-install
+1 NEW DETAILS,ENTRY
+2 FOR ENTRY=1:1
SET DETAILS=$PIECE($TEXT(ENTRIES+ENTRY),";",2,4)
if DETAILS=""
QUIT
Begin DoDot:1
+3 NEW DA,NAME,PNAME,TYPE,X,Y
+4 SET NAME=$PIECE(DETAILS,";")
SET PNAME=$PIECE(DETAILS,";",2)
SET TYPE=$PIECE(DETAILS,";",3)
+5 IF TYPE="OBJ"
SET DA=$$CROBJ^TIUCROBJ(NAME,"",PNAME,"S X=$$PGULF^TIUMSER(DFN)")
+6 IF TYPE="DC"
SET DA=$$CRDD^TIUCRDD(NAME,TYPE,11,"PROGRESS NOTES")
+7 IF TYPE="DOC"
Begin DoDot:2
+8 ; remove previously linked entries
+9 DO UNLINK
End DoDot:2
SET DA=$$CRDD^TIUCRDD(NAME,TYPE,11,"VA-GULFVET QUESTIONNAIRE","PRIMARY CARE NOTE")
+10 if PNAME=""
QUIT
+11 NEW TIU,ERROR
+12 SET TIU(8925.1,$$LU(8925.1,NAME,"X")_",",.03)=PNAME
+13 DO UPDATE^DIE("","TIU","","ERROR")
End DoDot:1
+14 QUIT
UNLINK ;
+1 NEW NAME
SET NAME="GULFVET QUESTIONNAIRE"
+2 NEW DIALOG
SET DIALOG=$$LU(801.41,"VA-GULFVET QUESTIONNAIRE","X","I $P(^(0),U,4)=""R""")
if 'DIALOG
QUIT
+3 NEW OUT
DO FIND^DIC(8927,"","@;.01I","P",NAME,"","","","","OUT")
+4 NEW PARENT
SET PARENT=$$LU(8927,"Document Titles","X")
if 'PARENT
QUIT
+5 NEW NUM
SET NUM=0
FOR
SET NUM=$ORDER(OUT("DILIST",NUM))
if 'NUM
QUIT
Begin DoDot:1
+6 NEW IEN
SET IEN=+OUT("DILIST",NUM,0)
+7 NEW NODE
SET NODE=$GET(^TIU(8927,IEN,0))
+8 ; personal owner
if $PIECE(NODE,U,6)>0
QUIT
+9 ; reminder dialog
if $PIECE(NODE,U,15)'=DIALOG
QUIT
+10 NEW NUM
SET NUM=0
FOR
SET NUM=$ORDER(^TIU(8927,PARENT,10,NUM))
if 'NUM
QUIT
Begin DoDot:2
+11 if $PIECE($GET(^TIU(8927,PARENT,10,NUM,0)),U,2)'=IEN
QUIT
+12 ; remove entries from parent first
NEW DA,DIK
SET DA(1)=PARENT
SET DA=NUM
SET DIK="^TIU(8927,"_DA(1)_",10,"
DO ^DIK
End DoDot:2
+13 ; remove entry
NEW DA,DIK
SET DA=IEN
SET DIK="^TIU(8927,"
DO ^DIK
End DoDot:1
+14 QUIT
