source: FOIAVistA/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDFC1.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 2.8 KB
Line 
1IBDFC1 ;ALB/CJM - ENCOUNTER FORM - CONVERTED FORMS LIST ;MAR 3, 1995
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
3 ;
4LIST ;
5 N IBCLINIC,IBTKFORM,IBTKBLK,IBAPI
6 S (IBTKFORM,IBTKBLK,IBCLINIC)=""
7 S IBAPI("INDEX")="D IDXFORMS^IBDFC1"
8 S IBAPI("SELECT")="D SELECT^IBDFC1"
9 D EN^VALM("IBDFC CONVERSION LOG")
10 D VALMSG^IBDFC
11 S VALMBCK="R"
12 Q
13 ;
14ONENTRY ;
15 D IDXFORMS
16 Q
17ONEXIT ;
18 K ^TMP("IBDF",$J,"CONVERTED FORMS")
19 Q
20 ;
21HDR ;
22 S VALMHDR(1)=" *** LOG OF FORMS THAT HAVE BEEN CONVERTED FOR SCANNING ***"
23 Q
24 ;
25IDXFORMS ;build a list of converted forms
26 N IEN
27 K @VALMAR
28 S VALMCNT=0
29 S IEN=0 F S IEN=$O(^IBD(359,IEN)) Q:'IEN D ENTRY
30 Q
31 ;
32ENTRY ;adds an entry to the array
33 N NODE,FORM,WARNING,REPLACED
34 S NODE=$G(^IBD(359,IEN,0))
35 Q:NODE=""
36 S FORM=+NODE
37 S VALMCNT=VALMCNT+1
38 S WARNING=$S($O(^IBD(359,IEN,1,0)):"YES",1:"NO ")
39 S REPLACED=$S($P(NODE,"^",5):"YES",1:"NO ")
40 S @VALMAR@(VALMCNT,0)=$J(VALMCNT,3)_" "_$$LJ^XLFSTR($P(NODE,"^",3),30)_" "_$$LJ^XLFSTR($$FMTE^XLFDT($P(NODE,"^",4),"2D"),10)_" "_$$CJ^XLFSTR(WARNING,8)_" "_$$CJ^XLFSTR(REPLACED,18)
41 D FLDCTRL^VALM10(VALMCNT) ;set video for ID column
42 I WARNING="YES" D CNTRL^VALM10(VALMCNT,52,3,IOINHI,IOINORM,0)
43 I REPLACED="NO " D CNTRL^VALM10(VALMCNT,69,2,IOINHI,IOINORM,0)
44 S @VALMAR@("IDX",VALMCNT,VALMCNT)=FORM_"^"_IEN
45 Q
46 ;
47SELECT ;returns IBFORM,IBCNVRT
48 N SEL
49 K DIR
50 D EN^VALM2(XQORNOD(0),"S")
51 S SEL=$O(VALMY(""))
52 S IBFORM=$S('SEL:"",1:+$G(@VALMAR@("IDX",SEL,SEL)))
53 S IBCNVRT=$S('SEL:"",1:$P($G(@VALMAR@("IDX",SEL,SEL)),"^",2))
54 Q
55 ;
56WARNINGS ;displays conversion warnings
57 N IBFORM,IBARY,IBHDRRTN,IBCNVRT
58 D SELECT
59 Q:'IBCNVRT
60 S IBARY="^IBD(359,"_IBCNVRT_",1)"
61 S IBHDRRTN="D WARNHDR^IBDFC1"
62 D EN^VALM("IBDE TEXT DISPLAY")
63 S VALMBCK="R"
64 Q
65WARNHDR ;
66 S VALMHDR(1)=" *** Conversion Warnings For "_$P($G(^IBD(359,IBCNVRT,0)),"^",3)_" ***"
67 Q
68 ;
69DELFORM ;used to delete forms from other places than the clinic setup screen
70 N CLINIC,IBFORM,IBCNVRT,BLOCK,NOCANDO,SETUP,ARY
71 S NOCANDO=0,ARY="^TMP(""IBDF"",$J,""TEMPORARY CLINIC LIST"")"
72 K @ARY
73 S VALMBCK="R"
74 I $G(IBAPI("SELECT"))'="" X IBAPI("SELECT")
75 Q:'IBFORM
76 D CLINICS^IBDFU4(IBFORM,ARY)
77 I $G(@ARY@(0)) D
78 .W !,"Cannot be deleted, the form is in use!"
79 .D LIST^IBDFU4(ARY,IOSL)
80 I '$G(@ARY@(0)) D
81 .D DELETE^IBDFU2C(.IBFORM,357,1)
82 .I '$G(IBFORM) D
83 ..K DIK,DA S DIK="^IBD(359,",DA=IBCNVRT D ^DIK K DIK,DA
84 ..D IDXFORMS
85 K @ARY
86 Q
87 ;
88PURGE ;purge the conversion log
89 N SDATE,IBCNVRT,NODE
90 S VALMBCK="R"
91 W !,"What is the last dated entry in the conversion log that should be deleted?"
92 K DIR S DIR(0)="D"
93 S DIR("B")=$$FMTE^XLFDT($$FMADD^XLFDT(DT,-25))
94 D ^DIR
95 I '$D(DIRUT),Y>0,Y'>DT S SDATE=Y D
96 .K DIK S DIK="^IBD(359,"
97 .S IBCNVRT=0 F S IBCNVRT=$O(^IBD(359,IBCNVRT)) Q:'IBCNVRT S NODE=$G(^IBD(359,IBCNVRT,0)) I $P(NODE,"^",4),$P(NODE,"^",4)'>SDATE S DA=IBCNVRT D ^DIK
98 .D IDXFORMS
99 K DIK,Y,DIR,DA,X
100 Q
Note: See TracBrowser for help on using the repository browser.