APCDDVD1.m

APCDDVD1 ; IHS/CMI/LAB - CONT OF APCDDVD ;

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

START ;

 K APCDCNTR

 D @APCDPROC

 Q

P ; Run by Posting date  

 G:APCDVSET=2 PX

 S APCDBDFN=$O(^AUPNVSIT("AMRG",APCDSD)) Q:APCDBDFN=""  S APCDBDFN=$O(^AUPNVSIT("AMRG",APCDBDFN,""))

 S APCDVSIT=APCDBDFN-1 F  S APCDVSIT=$O(^AUPNVSIT(APCDVSIT)) Q:APCDVSIT'=+APCDVSIT  Q:$P(^AUPNVSIT(APCDVSIT,0),U,2)>APCDED  D PROC

 Q:APCDVSET=1

PX S APCDODAT=APCDSD F  S APCDODAT=$O(^AUPNVSIT("ADWO",APCDODAT)) Q:APCDODAT>APCDED!(APCDODAT="")  D PV

 Q

PV ;

 S APCDVSIT="" F  S APCDVSIT=$O(^AUPNVSIT("ADWO",APCDODAT,APCDVSIT)) Q:APCDVSIT'=+APCDVSIT  D PROC

 Q

V ; Run by visit date

 S APCDODAT=$O(^AUPNVSIT("B",APCDSD)) Q:APCDODAT=""

 S APCDODAT=APCDSD_".9999" F  S APCDODAT=$O(^AUPNVSIT("B",APCDODAT)) Q:APCDODAT=""!((APCDODAT\1)>APCDED)  D V1

 Q

V1 ;

 S APCDVSIT="" F  S APCDVSIT=$O(^AUPNVSIT("B",APCDODAT,APCDVSIT)) Q:APCDVSIT'=+APCDVSIT  I $D(^AUPNVSIT(APCDVSIT,0)) D PROC

 Q

PROC ;

 Q:$$DEMO^APCLUTL($P(^AUPNVSIT(APCDVSIT,0),U,5),APCDDEMO)

 Q:$P(^AUPNVSIT(APCDVSIT,0),U,5)=""

 Q:$P(^AUPNVSIT(APCDVSIT,0),U,6)=""

 Q:$P(^AUPNVSIT(APCDVSIT,0),U,2)=""

 Q:$P(^AUPNVSIT(APCDVSIT,0),U,23)=.5

 Q:$P($G(^AUPNVSIT(APCDVSIT,11)),U,13)  ;mfi

 Q:$P(^AUPNVSIT(APCDVSIT,0),U,11)

 I APCDCLNL,$P(^AUPNVSIT(APCDVSIT,0),U,8)'=APCDCLNL Q  ;clinic screen

 I APCDECHS Q:$P(^AUPNVSIT(APCDVSIT,0),U,3)="C"

 I APCDLOCT="O",$P(^AUPNVSIT(APCDVSIT,0),U,6)'=APCDLOCT("ONE") Q

 I APCDLOCT="S",$$VALI^XBDIQ1(9999999.06,$P(^AUPNVSIT(APCDVSIT,0),U,6),.05)'=APCDLOCT("SU") Q

 I APCDVSET'=1,'$D(^AUPNVSIT("ADWO",$P(^AUPNVSIT(APCDVSIT,0),U,2),APCDVSIT)),$P(^AUPNVSIT(APCDVSIT,0),U,13)]"",'$D(^AUPNVSIT("ADWO",$P($P(^AUPNVSIT(APCDVSIT,0),U,13),"."),APCDVSIT)) Q

 S APCDDV("VREC")=^AUPNVSIT(APCDVSIT,0),DFN=$P(APCDDV("VREC"),U,5)

 S APCDCLIN=$$VAL^XBDIQ1(9000010,APCDVSIT,.08)

 I APCDCLIN="" S APCDCLIN="NO CLINIC"

 I APCDSORT'="C" S APCDCLIN="ALL"

 Q:'DFN

 I '$D(^AUPNPAT(DFN,0)) Q

 I '$D(^DPT(DFN,0)) Q

 D @APCDT^APCDDVC

 Q

 ;

APCDDVD1  ; IHS/CMI/LAB - CONT OF APCDDVD ;

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

START     ;

 +1        KILL APCDCNTR

 +2        DO @APCDPROC

 +3        QUIT 

P         ; Run by Posting date  

 +1        IF APCDVSET=2

               GOTO PX

 +2        SET APCDBDFN=$ORDER(^AUPNVSIT("AMRG",APCDSD))

           IF APCDBDFN=""

               QUIT 

           SET APCDBDFN=$ORDER(^AUPNVSIT("AMRG",APCDBDFN,""))

 +3        SET APCDVSIT=APCDBDFN-1

           FOR 

               SET APCDVSIT=$ORDER(^AUPNVSIT(APCDVSIT))

               IF APCDVSIT'=+APCDVSIT

                   QUIT 

               IF $PIECE(^AUPNVSIT(APCDVSIT,0),U,2)>APCDED

                   QUIT 

               DO PROC

 +4        IF APCDVSET=1

               QUIT 

PX         SET APCDODAT=APCDSD

           FOR 

               SET APCDODAT=$ORDER(^AUPNVSIT("ADWO",APCDODAT))

               IF APCDODAT>APCDED!(APCDODAT="")

                   QUIT 

               DO PV

 +1        QUIT 

PV        ;

 +1        SET APCDVSIT=""

           FOR 

               SET APCDVSIT=$ORDER(^AUPNVSIT("ADWO",APCDODAT,APCDVSIT))

               IF APCDVSIT'=+APCDVSIT

                   QUIT 

               DO PROC

 +2        QUIT 

V         ; Run by visit date

 +1        SET APCDODAT=$ORDER(^AUPNVSIT("B",APCDSD))

           IF APCDODAT=""

               QUIT 

 +2        SET APCDODAT=APCDSD_".9999"

           FOR 

               SET APCDODAT=$ORDER(^AUPNVSIT("B",APCDODAT))

               IF APCDODAT=""!((APCDODAT\1)>APCDED)

                   QUIT 

               DO V1

 +3        QUIT 

V1        ;

 +1        SET APCDVSIT=""

           FOR 

               SET APCDVSIT=$ORDER(^AUPNVSIT("B",APCDODAT,APCDVSIT))

               IF APCDVSIT'=+APCDVSIT

                   QUIT 

               IF $DATA(^AUPNVSIT(APCDVSIT,0))

                   DO PROC

 +2        QUIT 

PROC      ;

 +1        IF $$DEMO^APCLUTL($PIECE(^AUPNVSIT(APCDVSIT,0),U,5),APCDDEMO)

               QUIT 

 +2        IF $PIECE(^AUPNVSIT(APCDVSIT,0),U,5)=""

               QUIT 

 +3        IF $PIECE(^AUPNVSIT(APCDVSIT,0),U,6)=""

               QUIT 

 +4        IF $PIECE(^AUPNVSIT(APCDVSIT,0),U,2)=""

               QUIT 

 +5        IF $PIECE(^AUPNVSIT(APCDVSIT,0),U,23)=.5

               QUIT 

 +6       ;mfi

           IF $PIECE($GET(^AUPNVSIT(APCDVSIT,11)),U,13)

               QUIT 

 +7        IF $PIECE(^AUPNVSIT(APCDVSIT,0),U,11)

               QUIT 

 +8       ;clinic screen

           IF APCDCLNL

               IF $PIECE(^AUPNVSIT(APCDVSIT,0),U,8)'=APCDCLNL

                   QUIT 

 +9        IF APCDECHS

               IF $PIECE(^AUPNVSIT(APCDVSIT,0),U,3)="C"

                   QUIT 

 +10       IF APCDLOCT="O"

               IF $PIECE(^AUPNVSIT(APCDVSIT,0),U,6)'=APCDLOCT("ONE")

                   QUIT 

 +11       IF APCDLOCT="S"

               IF $$VALI^XBDIQ1(9999999.06,$PIECE(^AUPNVSIT(APCDVSIT,0),U,6),.05)'=APCDLOCT("SU")

                   QUIT 

 +12       IF APCDVSET'=1

               IF '$DATA(^AUPNVSIT("ADWO",$PIECE(^AUPNVSIT(APCDVSIT,0),U,2),APCDVSIT))

                   IF $PIECE(^AUPNVSIT(APCDVSIT,0),U,13)]""

                       IF '$DATA(^AUPNVSIT("ADWO",$PIECE($PIECE(^AUPNVSIT(APCDVSIT,0),U,13),"."),APCDVSIT))

                           QUIT 

 +13       SET APCDDV("VREC")=^AUPNVSIT(APCDVSIT,0)

           SET DFN=$PIECE(APCDDV("VREC"),U,5)

 +14       SET APCDCLIN=$$VAL^XBDIQ1(9000010,APCDVSIT,.08)

 +15       IF APCDCLIN=""

               SET APCDCLIN="NO CLINIC"

 +16       IF APCDSORT'="C"

               SET APCDCLIN="ALL"

 +17       IF 'DFN

               QUIT 

 +18       IF '$DATA(^AUPNPAT(DFN,0))

               QUIT 

 +19       IF '$DATA(^DPT(DFN,0))

               QUIT 

 +20       DO @APCDT^APCDDVC

 +21       QUIT 

 +22      ;