APCDVREF.m

APCDVREF ; IHS/CMI/LAB - POV LOOKUP ; 13 Feb 2014  2:26 PM

 ;;2.0;IHS PCC SUITE;**20**;MAY 14, 2009;Build 25

 ;

FIX ;PEP - CALLED TO STUFF 1202 OF V REFERRAL WITH REQUESTING PROVIDER

 ;FROM RCIS REFERRAL ENTRY

 ;NULL OUT 1210 FIELD VALUE

 ;MOVE AND CORRECT V REFERRAL INFO BASED ON REFERRAL ENTRY

 NEW APCDVREF,APCDREF,APCDRP

 S APCDVREF=0 F  S APCDVREF=$O(^AUPNVREF(APCDVREF)) Q:APCDVREF'=+APCDVREF  D

 .S APCDREF=$$VALI^XBDIQ1(9000010.59,APCDVREF,.06)

 .Q:APCDREF=""  ;NO REFERRAL IEN

 .Q:'$D(^BMCREF(APCDREF,0))  ;no referral??

 .S APCDRP=$$VALI^XBDIQ1(90001,APCDREF,.06)  ;REQUESTING PROVIDER IEN

 .S DIE="^AUPNVREF(",DA=APCDVREF

 .I APCDRP S DR="1210///@;1202////"_APCDRP

 .I 'APCDRP S DR="1210///@;1202///@"

 .D ^DIE

 .I $D(Y) D EN^DDIOL("failure to update v referral "_APCDVREF)

 .K DIE,DA,DR

 .Q

 Q

APCDVREF  ; IHS/CMI/LAB - POV LOOKUP ; 13 Feb 2014  2:26 PM

 +1       ;;2.0;IHS PCC SUITE;**20**;MAY 14, 2009;Build 25

 +2       ;

FIX       ;PEP - CALLED TO STUFF 1202 OF V REFERRAL WITH REQUESTING PROVIDER

 +1       ;FROM RCIS REFERRAL ENTRY

 +2       ;NULL OUT 1210 FIELD VALUE

 +3       ;MOVE AND CORRECT V REFERRAL INFO BASED ON REFERRAL ENTRY

 +4        NEW APCDVREF,APCDREF,APCDRP

 +5        SET APCDVREF=0

           FOR 

               SET APCDVREF=$ORDER(^AUPNVREF(APCDVREF))

               IF APCDVREF'=+APCDVREF

                   QUIT 

               Begin DoDot:1

 +6                SET APCDREF=$$VALI^XBDIQ1(9000010.59,APCDVREF,.06)

 +7       ;NO REFERRAL IEN

                   IF APCDREF=""

                       QUIT 

 +8       ;no referral??

                   IF '$DATA(^BMCREF(APCDREF,0))

                       QUIT 

 +9       ;REQUESTING PROVIDER IEN

                   SET APCDRP=$$VALI^XBDIQ1(90001,APCDREF,.06)

 +10               SET DIE="^AUPNVREF("

                   SET DA=APCDVREF

 +11               IF APCDRP

                       SET DR="1210///@;1202////"_APCDRP

 +12               IF 'APCDRP

                       SET DR="1210///@;1202///@"

 +13               DO ^DIE

 +14               IF $DATA(Y)

                       DO EN^DDIOL("failure to update v referral "_APCDVREF)

 +15               KILL DIE,DA,DR

 +16               QUIT 

               End DoDot:1

 +17       QUIT