APCDVM3.m

APCDVM3 ; IHS/CMI/LAB - XECUTES NODES IN MODULE PCC LINK CONTROL FILE ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009;Build 18

 ;

 ;     APCDVMF= From visit DFN

 ;     APCDVMT= To visit DFN

 ;

 F APCDVM=0:0 S APCDVM=$O(^APCDLINK(APCDVM)) Q:APCDVM'=+APCDVM  X:$D(^(APCDVM,1)) ^(1)

 K APCDVM

 I $D(ZTQUEUED) S ZTREQ="@"

 I $D(ZTQUEUED) S ZTREQ="@"

 Q

 ;

PROBLEM ;EP - called to change pointers in AUPNPROB from used as pov and used as inpatient afer merge

 NEW APCDP,APCDX

 I '$G(APCDVMT) Q

 I '$G(APCDVMF) Q

 S APCDP=$P($G(^AUPNVSIT(APCDVMT,0)),U,5)

 I 'APCDP Q  ;;NO PATIENT??

 S APCDX=0 F  S APCDX=$O(^AUPNPROB("AC",APCDP,APCDX)) Q:APCDX'=+APCDX  D

 .;USED AS POV

 .S APCDY=0 F  S APCDY=$O(^AUPNPROB(APCDX,14,"B",APCDVMF,APCDY)) Q:APCDY'=+APCDY  D

 ..;call die to change to APCDVMT

 ..K DIE,DA,DR

 ..S DA(1)=APCDX,DA=APCDY,DIE="^AUPNPROB("_APCDX_",14,",DR=".01////"_APCDVMT

 ..D ^DIE

 ..K DIE,DA,DR

 .;USED AS INPATIENT

 .S APCDY=0 F  S APCDY=$O(^AUPNPROB(APCDX,15,"B",APCDVMF,APCDY)) Q:APCDY'=+APCDY  D

 ..;call die to change to APCDVMT

 ..K DIE,DA,DR

 ..S DA(1)=APCDX,DA=APCDY,DIE="^AUPNPROB("_APCDX_",15,",DR=".01////"_APCDVMT

 ..D ^DIE

 ..K DIE,DA,DR

 .Q

APCDVM3   ; IHS/CMI/LAB - XECUTES NODES IN MODULE PCC LINK CONTROL FILE ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009;Build 18

 +2       ;

 +3       ;     APCDVMF= From visit DFN

 +4       ;     APCDVMT= To visit DFN

 +5       ;

 +6        FOR APCDVM=0:0

               SET APCDVM=$ORDER(^APCDLINK(APCDVM))

               IF APCDVM'=+APCDVM

                   QUIT 

               IF $DATA(^(APCDVM,1))

                   XECUTE ^(1)

 +7        KILL APCDVM

 +8        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +9        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +10       QUIT 

 +11      ;

PROBLEM   ;EP - called to change pointers in AUPNPROB from used as pov and used as inpatient afer merge

 +1        NEW APCDP,APCDX

 +2        IF '$GET(APCDVMT)

               QUIT 

 +3        IF '$GET(APCDVMF)

               QUIT 

 +4        SET APCDP=$PIECE($GET(^AUPNVSIT(APCDVMT,0)),U,5)

 +5       ;;NO PATIENT??

           IF 'APCDP

               QUIT 

 +6        SET APCDX=0

           FOR 

               SET APCDX=$ORDER(^AUPNPROB("AC",APCDP,APCDX))

               IF APCDX'=+APCDX

                   QUIT 

               Begin DoDot:1

 +7       ;USED AS POV

 +8                SET APCDY=0

                   FOR 

                       SET APCDY=$ORDER(^AUPNPROB(APCDX,14,"B",APCDVMF,APCDY))

                       IF APCDY'=+APCDY

                           QUIT 

                       Begin DoDot:2

 +9       ;call die to change to APCDVMT

 +10                       KILL DIE,DA,DR

 +11                       SET DA(1)=APCDX

                           SET DA=APCDY

                           SET DIE="^AUPNPROB("_APCDX_",14,"

                           SET DR=".01////"_APCDVMT

 +12                       DO ^DIE

 +13                       KILL DIE,DA,DR

                       End DoDot:2

 +14      ;USED AS INPATIENT

 +15               SET APCDY=0

                   FOR 

                       SET APCDY=$ORDER(^AUPNPROB(APCDX,15,"B",APCDVMF,APCDY))

                       IF APCDY'=+APCDY

                           QUIT 

                       Begin DoDot:2

 +16      ;call die to change to APCDVMT

 +17                       KILL DIE,DA,DR

 +18                       SET DA(1)=APCDX

                           SET DA=APCDY

                           SET DIE="^AUPNPROB("_APCDX_",15,"

                           SET DR=".01////"_APCDVMT

 +19                       DO ^DIE

 +20                       KILL DIE,DA,DR

                       End DoDot:2

 +21               QUIT 

               End DoDot:1