- 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 ;
