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 ;