Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: APCDDVD1

APCDDVD1.m

Go to the documentation of this file.
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
 ;