- 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 Mar 13, 2025@21:43:34 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
