[613] | 1 | IBDFPCE ;ALB/AAS - AICS UPDATE FROM PCE ; 12-DEC-95
|
---|
| 2 | ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
|
---|
| 3 | ;
|
---|
| 4 | MAN ; -- 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 | ;
|
---|
| 27 | UPDATE(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
|
---|