source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUFHA6.m@ 1650

Last change on this file since 1650 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.0 KB
Line 
1TIUFHA6 ; SLC/MAM - Templates A H J C D X Action TRY ;12/4/97
2 ;;1.0;TEXT INTEGRATION UTILITIES;**5,12**;Jun 20, 1997
3 ;
4CHECKDEF ; Templates A, C, H, D, X, J Action Try
5 N INFO,FILEDA,MSG,TIUFXNOD,SUCCESS,NODE0,CLASSFDA,ANCEST,TIUFI,PFILEDA
6 N SUBS,DTOUT,DIRUT,DIROUT,DETAILS,DODOCMT
7 S VALMBCK="",TIUFXNOD=$G(XQORNOD(0))
8 I $P(TIUFXNOD,U,3)="TR" W "Try",! S $P(TIUFXNOD,U,4)="TR="_$P($P(TIUFXNOD,U,4),"==",2)
9 I $P(TIUFXNOD,U,3)="TRY" W "Try",! S $P(TIUFXNOD,U,4)="TRY="_$P($P(TIUFXNOD,U,4),"==",2)
10 I $G(TIUFSTMP)="T" W !!,"Action Try not available on items screen.",! H 2 Q
11 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
12 I $D(TIUFSTMP) S FILEDA=$P(TIUFINFO,U,2)
13 S PFILEDA=+$O(^TIU(8925.1,"AD",FILEDA,0)),DETAILS=1
14 N TIUFCK D CHECK^TIUFLF3(FILEDA,PFILEDA,DETAILS,.TIUFCK)
15 G:$D(DTOUT) CHECX
16 ; If all OK, Try on Document if Title, and quit:
17 I TIUFCK W !! D D PAUSE^TIUFXHLX Q:$D(DIRUT) D:$D(^TIU(8925.1,"AT","DOC",FILEDA)) DOCMT(FILEDA) Q
18 . I $G(TIUFSTMP)="X" W "Boilerplate Text looks OK; no bad/inactive Objects.",! Q
19 . W $S($D(^TIU(8925.1,"AT","O",FILEDA)):"Object",1:"Entry")," looks OK; no problems found.",!
20 ; If not all OK, write out nonobject problems:
21 K DIRUT
22 ; If NOT in subtemplate X:
23 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
24 . 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
25 ; If not all OK, is Object, write out object problems and quit:
26 I $D(^TIU(8925.1,"AT","O",FILEDA)) D Q
27 . F SUBS="J","JN","JA","JP" I $D(TIUFCK(SUBS)) S MSG="Faulty Object: "_TIUFCK(SUBS) W !!!,MSG,! D PAUSE^TIUFXHLX Q:$D(DIRUT)
28 ; If not all OK, has Btext problem, then write Btext problem:
29 ; If NOT in subtemplate X or D:
30 I '$D(TIUFSTMP),$D(TIUFCK("OBJ"))!$D(TIUFCK("OBJINACT")) D
31 . 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
32 ; If in subtemplate X or D:
33 I $D(TIUFCK("OBJ"))!$D(TIUFCK("OBJINACT")),$G(TIUFSTMP)'="","XD"[$G(TIUFSTMP) D
34 . 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.
35 ; If not all OK, no Btext problem, in subtemplate X, then write Btext OK:
36 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)
37 ; If not all OK, non Btext problem, in subtemplate X, then write Entry itself is faulty:
38 K TIUFCK("OBJINACT") S DODOCMT=$S($D(TIUFCK)'>9:1,1:0) K TIUFCK("OBJ")
39 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)
40 ; If is Title and inactive object in Btext is the only problem,
41 ; then try on document:
42 I $D(^TIU(8925.1,"AT","DOC",FILEDA)) I DODOCMT D DOCMT(FILEDA)
43CHECX I $D(DTOUT) S VALMBCK="Q"
44 Q
45 ;
46DOCMT(FILEDA) ; Try entry on a document
47 I $D(DIRUT) Q
48 D FULL^VALM1
49 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.",!
50 W !,"Be sure to select a TEST PATIENT since the document will show up on Unsigned",!,"lists while you are editing it.",!
51 S NODE0=^TIU(8925.1,FILEDA,0) D ANCESTOR^TIUFLF4(FILEDA,NODE0,.ANCEST,0)
52 S TIUFI=$O(ANCEST(100),-1) S CLASSFDA=$G(ANCEST(TIUFI-1)) I 'CLASSFDA W !!,"Ancestry ERROR; See IRM" D PAUSE^TIUFXHLX
53 I CLASSFDA N FPRI,INDEX,TIUASK,VALUE D MAIN^TIUEDIT(CLASSFDA,.SUCCESS,"",FILEDA,1,1) H 1 Q:$D(DTOUT)
54 S VALMSG=$$VMSG^TIUFL D RE^VALM4,RESET^TIUFXHLX
55 Q
56 ;
Note: See TracBrowser for help on using the repository browser.