- TIUFHA6 ; SLC/MAM - Templates A H J C D X Action TRY ;12/4/97
- ;;1.0;TEXT INTEGRATION UTILITIES;**5,12**;Jun 20, 1997
- ;IHS/ITSC/LJF 6/12/2003 - Changed "TRY" action to use visits already created
- ;
- CHECKDEF ; Templates A, C, H, D, X, J Action Try
- N INFO,FILEDA,MSG,TIUFXNOD,SUCCESS,NODE0,CLASSFDA,ANCEST,TIUFI,PFILEDA
- N SUBS,DTOUT,DIRUT,DIROUT,DETAILS,DODOCMT
- S VALMBCK="",TIUFXNOD=$G(XQORNOD(0))
- I $P(TIUFXNOD,U,3)="TR" W "Try",! S $P(TIUFXNOD,U,4)="TR="_$P($P(TIUFXNOD,U,4),"==",2)
- I $P(TIUFXNOD,U,3)="TRY" W "Try",! S $P(TIUFXNOD,U,4)="TRY="_$P($P(TIUFXNOD,U,4),"==",2)
- I $G(TIUFSTMP)="T" W !!,"Action Try not available on items screen.",! H 2 Q
- I '$D(TIUFSTMP) D EN^VALM2(TIUFXNOD,"SO") G:'$O(VALMY(0)) CHECX S INFO=$G(^TMP("TIUF1IDX",$J,$O(VALMY(0)))),FILEDA=$P(INFO,U,2) I 'INFO W !!,"Missing List Manager Data; See IRM",! D PAUSE^TIUFXHLX S VALMBCK="Q" G CHECX
- I $D(TIUFSTMP) S FILEDA=$P(TIUFINFO,U,2)
- S PFILEDA=+$O(^TIU(8925.1,"AD",FILEDA,0)),DETAILS=1
- N TIUFCK D CHECK^TIUFLF3(FILEDA,PFILEDA,DETAILS,.TIUFCK)
- G:$D(DTOUT) CHECX
- ; If all OK, Try on Document if Title, and quit:
- I TIUFCK W !! D D PAUSE^TIUFXHLX Q:$D(DIRUT) D:$D(^TIU(8925.1,"AT","DOC",FILEDA)) DOCMT(FILEDA) Q
- . I $G(TIUFSTMP)="X" W "Boilerplate Text looks OK; no bad/inactive Objects.",! Q
- . W $S($D(^TIU(8925.1,"AT","O",FILEDA)):"Object",1:"Entry")," looks OK; no problems found.",!
- ; If not all OK, write out nonobject problems:
- K DIRUT
- ; If NOT in subtemplate X:
- I $G(TIUFSTMP)'="X" F SUBS="F","I","T","C","B","O","S","M","U","A","E","R","V","D","H","N","G","P","DESC" D G:$D(DIRUT) CHECX
- . I $D(TIUFCK(SUBS)) S MSG=$S(SUBS="P":"Entry is an ",$D(^TIU(8925.1,"AT","O",FILEDA)):"Faulty Object: ",1:"Faulty Entry: ")_TIUFCK(SUBS) W !!!,MSG,! D PAUSE^TIUFXHLX
- ; If not all OK, is Object, write out object problems and quit:
- I $D(^TIU(8925.1,"AT","O",FILEDA)) D Q
- . F SUBS="J","JN","JA","JP" I $D(TIUFCK(SUBS)) S MSG="Faulty Object: "_TIUFCK(SUBS) W !!!,MSG,! D PAUSE^TIUFXHLX Q:$D(DIRUT)
- ; If not all OK, has Btext problem, then write Btext problem:
- ; If NOT in subtemplate X or D:
- I '$D(TIUFSTMP),$D(TIUFCK("OBJ"))!$D(TIUFCK("OBJINACT")) D
- . W !!!,$S($D(TIUFCK("OBJ")):"Faulty Entry: Bad",1:"Inactive")," Object in Boilerplate Text. For details, select",!,"Action BOILERPLATE TEXT, then Action TRY.",! D PAUSE^TIUFXHLX ;template A or H or C
- ; If in subtemplate X or D:
- I $D(TIUFCK("OBJ"))!$D(TIUFCK("OBJINACT")),$G(TIUFSTMP)'="","XD"[$G(TIUFSTMP) D
- . K DIRUT N TIUFCK D XCHECK^TIUFLX(FILEDA,0,1,.TIUFCK) Q:$D(DIRUT) D DCHECK^TIUFLX(FILEDA,0,1,.TIUFCK) ; 0 for NOT Silent. XCHECK writes out specific problems for each bad object in Btext.
- ; If not all OK, no Btext problem, in subtemplate X, then write Btext OK:
- I $G(TIUFSTMP)="X",'$D(TIUFCK("OBJ")),'$D(TIUFCK("OBJINACT")) W !!!,"Boilerplate Text looks OK; no bad/inactive Objects",! D PAUSE^TIUFXHLX Q:$D(DIRUT)
- ; If not all OK, non Btext problem, in subtemplate X, then write Entry itself is faulty:
- K TIUFCK("OBJINACT") S DODOCMT=$S($D(TIUFCK)'>9:1,1:0) K TIUFCK("OBJ")
- I $G(TIUFSTMP)="X",$D(TIUFCK)>9 W !!!,"Title/Component itself is faulty. For details, exit out of BOILERPLATE TEXT",!,"and TRY entry.",! D PAUSE^TIUFXHLX Q:$D(DIRUT)
- ; If is Title and inactive object in Btext is the only problem,
- ; then try on document:
- I $D(^TIU(8925.1,"AT","DOC",FILEDA)) I DODOCMT D DOCMT(FILEDA)
- CHECX I $D(DTOUT) S VALMBCK="Q"
- Q
- ;
- DOCMT(FILEDA) ; Try entry on a document
- I $D(DIRUT) Q
- D FULL^VALM1
- W !!,"Checking Title on a document. You will not be permitted to sign the document,",!,"and the document will be deleted at the end of the check.",!
- W !,"Be sure to select a TEST PATIENT since the document will show up on Unsigned",!,"lists while you are editing it.",!
- S NODE0=^TIU(8925.1,FILEDA,0) D ANCESTOR^TIUFLF4(FILEDA,NODE0,.ANCEST,0)
- S TIUFI=$O(ANCEST(100),-1) S CLASSFDA=$G(ANCEST(TIUFI-1)) I 'CLASSFDA W !!,"Ancestry ERROR; See IRM" D PAUSE^TIUFXHLX
- ;I CLASSFDA N FPRI,INDEX,TIUASK,VALUE D MAIN^TIUEDIT(CLASSFDA,.SUCCESS,"",FILEDA,1,1) H 1 Q:$D(DTOUT) ;IHS/ITSC/LJF 6/12/2003
- I CLASSFDA N FPRI,INDEX,TIUASK,VALUE D MAIN^TIUEDIT(CLASSFDA,.SUCCESS,"",FILEDA,0,1) H 1 Q:$D(DTOUT) ;IHS/ITSC/LJF 6/12/2003
- S VALMSG=$$VMSG^TIUFL D RE^VALM4,RESET^TIUFXHLX
- Q
- ;
- TIUFHA6 ; SLC/MAM - Templates A H J C D X Action TRY ;12/4/97
- +1 ;;1.0;TEXT INTEGRATION UTILITIES;**5,12**;Jun 20, 1997
- +2 ;IHS/ITSC/LJF 6/12/2003 - Changed "TRY" action to use visits already created
- +3 ;
- CHECKDEF ; Templates A, C, H, D, X, J Action Try
- +1 NEW INFO,FILEDA,MSG,TIUFXNOD,SUCCESS,NODE0,CLASSFDA,ANCEST,TIUFI,PFILEDA
- +2 NEW SUBS,DTOUT,DIRUT,DIROUT,DETAILS,DODOCMT
- +3 SET VALMBCK=""
- SET TIUFXNOD=$GET(XQORNOD(0))
- +4 IF $PIECE(TIUFXNOD,U,3)="TR"
- WRITE "Try",!
- SET $PIECE(TIUFXNOD,U,4)="TR="_$PIECE($PIECE(TIUFXNOD,U,4),"==",2)
- +5 IF $PIECE(TIUFXNOD,U,3)="TRY"
- WRITE "Try",!
- SET $PIECE(TIUFXNOD,U,4)="TRY="_$PIECE($PIECE(TIUFXNOD,U,4),"==",2)
- +6 IF $GET(TIUFSTMP)="T"
- WRITE !!,"Action Try not available on items screen.",!
- HANG 2
- QUIT
- +7 IF '$DATA(TIUFSTMP)
- DO EN^VALM2(TIUFXNOD,"SO")
- IF '$ORDER(VALMY(0))
- GOTO CHECX
- SET INFO=$GET(^TMP("TIUF1IDX",$JOB,$ORDER(VALMY(0))))
- SET FILEDA=$PIECE(INFO,U,2)
- IF 'INFO
- WRITE !!,"Missing List Manager Data; See IRM",!
- DO PAUSE^TIUFXHLX
- SET VALMBCK="Q"
- GOTO CHECX
- +8 IF $DATA(TIUFSTMP)
- SET FILEDA=$PIECE(TIUFINFO,U,2)
- +9 SET PFILEDA=+$ORDER(^TIU(8925.1,"AD",FILEDA,0))
- SET DETAILS=1
- +10 NEW TIUFCK
- DO CHECK^TIUFLF3(FILEDA,PFILEDA,DETAILS,.TIUFCK)
- +11 IF $DATA(DTOUT)
- GOTO CHECX
- +12 ; If all OK, Try on Document if Title, and quit:
- +13 IF TIUFCK
- WRITE !!
- Begin DoDot:1
- +14 IF $GET(TIUFSTMP)="X"
- WRITE "Boilerplate Text looks OK; no bad/inactive Objects.",!
- QUIT
- +15 WRITE $SELECT($DATA(^TIU(8925.1,"AT","O",FILEDA)):"Object",1:"Entry")," looks OK; no problems found.",!
- End DoDot:1
- DO PAUSE^TIUFXHLX
- IF $DATA(DIRUT)
- QUIT
- IF $DATA(^TIU(8925.1,"AT","DOC",FILEDA))
- DO DOCMT(FILEDA)
- QUIT
- +16 ; If not all OK, write out nonobject problems:
- +17 KILL DIRUT
- +18 ; If NOT in subtemplate X:
- +19 IF $GET(TIUFSTMP)'="X"
- FOR SUBS="F","I","T","C","B","O","S","M","U","A","E","R","V","D","H","N","G","P","DESC"
- Begin DoDot:1
- +20 IF $DATA(TIUFCK(SUBS))
- SET MSG=$SELECT(SUBS="P":"Entry is an ",$DATA(^TIU(8925.1,"AT","O",FILEDA)):"Faulty Object: ",1:"Faulty Entry: ")_TIUFCK(SUBS)
- WRITE !!!,MSG,!
- DO PAUSE^TIUFXHLX
- End DoDot:1
- IF $DATA(DIRUT)
- GOTO CHECX
- +21 ; If not all OK, is Object, write out object problems and quit:
- +22 IF $DATA(^TIU(8925.1,"AT","O",FILEDA))
- Begin DoDot:1
- +23 FOR SUBS="J","JN","JA","JP"
- IF $DATA(TIUFCK(SUBS))
- SET MSG="Faulty Object: "_TIUFCK(SUBS)
- WRITE !!!,MSG,!
- DO PAUSE^TIUFXHLX
- IF $DATA(DIRUT)
- QUIT
- End DoDot:1
- QUIT
- +24 ; If not all OK, has Btext problem, then write Btext problem:
- +25 ; If NOT in subtemplate X or D:
- +26 IF '$DATA(TIUFSTMP)
- IF $DATA(TIUFCK("OBJ"))!$DATA(TIUFCK("OBJINACT"))
- Begin DoDot:1
- +27 ;template A or H or C
- WRITE !!!,$SELECT($DATA(TIUFCK("OBJ")):"Faulty Entry: Bad",1:"Inactive")," Object in Boilerplate Text. For details, select",!,"Action BOILERPLATE TEXT, then Action TRY.",!
- DO PAUSE^TIUFXHLX
- End DoDot:1
- +28 ; If in subtemplate X or D:
- +29 IF $DATA(TIUFCK("OBJ"))!$DATA(TIUFCK("OBJINACT"))
- IF $GET(TIUFSTMP)'=""
- IF "XD"[$GET(TIUFSTMP)
- Begin DoDot:1
- +30 ; 0 for NOT Silent. XCHECK writes out specific problems for each bad object in Btext.
- KILL DIRUT
- NEW TIUFCK
- DO XCHECK^TIUFLX(FILEDA,0,1,.TIUFCK)
- IF $DATA(DIRUT)
- QUIT
- DO DCHECK^TIUFLX(FILEDA,0,1,.TIUFCK)
- End DoDot:1
- +31 ; If not all OK, no Btext problem, in subtemplate X, then write Btext OK:
- +32 IF $GET(TIUFSTMP)="X"
- IF '$DATA(TIUFCK("OBJ"))
- IF '$DATA(TIUFCK("OBJINACT"))
- WRITE !!!,"Boilerplate Text looks OK; no bad/inactive Objects",!
- DO PAUSE^TIUFXHLX
- IF $DATA(DIRUT)
- QUIT
- +33 ; If not all OK, non Btext problem, in subtemplate X, then write Entry itself is faulty:
- +34 KILL TIUFCK("OBJINACT")
- SET DODOCMT=$SELECT($DATA(TIUFCK)'>9:1,1:0)
- KILL TIUFCK("OBJ")
- +35 IF $GET(TIUFSTMP)="X"
- IF $DATA(TIUFCK)>9
- WRITE !!!,"Title/Component itself is faulty. For details, exit out of BOILERPLATE TEXT",!,"and TRY entry.",!
- DO PAUSE^TIUFXHLX
- IF $DATA(DIRUT)
- QUIT
- +36 ; If is Title and inactive object in Btext is the only problem,
- +37 ; then try on document:
- +38 IF $DATA(^TIU(8925.1,"AT","DOC",FILEDA))
- IF DODOCMT
- DO DOCMT(FILEDA)
- CHECX IF $DATA(DTOUT)
- SET VALMBCK="Q"
- +1 QUIT
- +2 ;
- DOCMT(FILEDA) ; Try entry on a document
- +1 IF $DATA(DIRUT)
- QUIT
- +2 DO FULL^VALM1
- +3 WRITE !!,"Checking Title on a document. You will not be permitted to sign the document,",!,"and the document will be deleted at the end of the check.",!
- +4 WRITE !,"Be sure to select a TEST PATIENT since the document will show up on Unsigned",!,"lists while you are editing it.",!
- +5 SET NODE0=^TIU(8925.1,FILEDA,0)
- DO ANCESTOR^TIUFLF4(FILEDA,NODE0,.ANCEST,0)
- +6 SET TIUFI=$ORDER(ANCEST(100),-1)
- SET CLASSFDA=$GET(ANCEST(TIUFI-1))
- IF 'CLASSFDA
- WRITE !!,"Ancestry ERROR; See IRM"
- DO PAUSE^TIUFXHLX
- +7 ;I CLASSFDA N FPRI,INDEX,TIUASK,VALUE D MAIN^TIUEDIT(CLASSFDA,.SUCCESS,"",FILEDA,1,1) H 1 Q:$D(DTOUT) ;IHS/ITSC/LJF 6/12/2003
- +8 ;IHS/ITSC/LJF 6/12/2003
- IF CLASSFDA
- NEW FPRI,INDEX,TIUASK,VALUE
- DO MAIN^TIUEDIT(CLASSFDA,.SUCCESS,"",FILEDA,0,1)
- HANG 1
- IF $DATA(DTOUT)
- QUIT
- +9 SET VALMSG=$$VMSG^TIUFL
- DO RE^VALM4
- DO RESET^TIUFXHLX
- +10 QUIT
- +11 ;
