source: WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDFPCE.m@ 738

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

initial load of WorldVistAEHR

File size: 1.7 KB
RevLine 
[613]1IBDFPCE ;ALB/AAS - AICS UPDATE FROM PCE ; 12-DEC-95
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
3 ;
4MAN ; -- called from IBDF PCE EVENT (invoked by the PXK VISIT DATA EVENT)
5 ; if aics starts event, quit
6 ; else
7 ; find appointment date from visit node
8 ; find entry in forms tracking for visit
9 ; update manual data entry field to yes if new or old visit edited
10 ; update manual data entry field to no if entry deleted
11 ;
12 Q:$D(IBD("AICS"))
13 N IBDVST,IBD,IBDFN
14 S (IBDVST,IBDFN)=""
15 ;
16 F S IBDVST=$O(^TMP("PXKCO",$J,IBDVST)) Q:'IBDVST D
17 .S IBDVST("AFTER")=$G(^TMP("PXKCO",$J,IBDVST,"VST",IBDVST,0,"AFTER")),IBDVST("BEFORE")=$G(^("BEFORE"))
18 .;
19 .; -- new or old visit
20 .I IBDVST("AFTER")]"",IBDVST("BEFORE")]""!(IBDVST("BEFORE")="") S IBD("APPT")=+IBDVST("AFTER"),IBD("VALUE")=1,IBDFN=$P(IBDVST("AFTER"),"^",5) D UPDATE(.IBD) Q
21 .;
22 .; -- deleted visit
23 .I IBDVST("AFTER")="",IBDVST("BEFORE")]"" S IBD("APPT")=+IBDVST("BEFORE"),IBD("VALUE")=0,IBDFN=$P(IBDVST("BEFORE"),"^",5) D UPDATE(.IBD) Q
24 ;
25 Q
26 ;
27UPDATE(IBD) ; -- procedure to update manual data entry detected
28 ;
29 N X,Y,DA,DIC,DIE,DR,IBDX,IBDC
30 Q:'$G(IBDFN)!('$G(IBD("APPT")))!('$G(IBD("VALUE")))
31 I '$D(IBD("FORM ID")) S IBD("FORM ID")=$$FINDID^IBDF18C(IBDFN,IBD("APPT"))
32 ;
33 ; -- ibd(form id) can be returned with multiple pieces if more than
34 ; one form for appt.
35 F IBDX=1:1 S DA=+$P(IBD("FORM ID"),"^",IBDX) Q:'DA D
36 . Q:$P($G(^IBD(357.96,+DA,0)),"^",13)
37 . Q:$P($G(^IBD(357.96,+DA,0)),"^",2)'=IBDFN
38 . Q:$P($G(^IBD(357.96,+DA,0)),"^",3)'=IBD("APPT")
39 . S DIE="^IBD(357.96,",DR=".13////"_+$G(IBD("VALUE"))
40 . D ^DIE S IBDC=$G(IBDC)+1
41 . I IBDC=1,'$D(ZTQUEUED) W !,"Updating Encounter Form Tracking (AICS)"
42 Q
Note: See TracBrowser for help on using the repository browser.