APCDR001 ; IHS/CMI/LAB - cont. review visit data ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
VISIT ;EP;check fields in visit file
D 06
D 05
D 01
Q
;
06 ;check for valid location of visit and code
S APCDLDFN=$P(APCDVREC,U,6) I APCDLDFN="" S APCDE("FILE")=9000010,APCDE("ENTRY")=APCDVSIT,APCDE="E111" D ERR^APCDRV Q
I '$D(^AUTTLOC(APCDLDFN,0)) S APCDE("FILE")=9000010,APCDE("ENTRY")=APCDVSIT,APCDE="E112" D ERR^APCDRV Q
I '$D(^DIC(4,APCDLDFN,0)) S APCDE("FILE")=9000010,APCDE("ENTRY")=APCDVSIT,APCDE="E112" D ERR^APCDRV Q
I $P(^AUTTLOC(APCDLDFN,0),U,10)="" S APCDE("FILE")=9000010,APCDE("ENTRY")=APCDVSIT,APCDE="E113" D ERR^APCDRV Q
I $L($P(^AUTTLOC(APCDLDFN,0),U,10))'=6 S APCDE("FILE")=9000010,APCDE("ENTRY")=APCDVSIT,APCDE="E114" D ERR^APCDRV
Q
;
05 ; check patient
S Y=$P(APCDVREC,U,5) I Y="" S APCDE("FILE")=9000010,APCDE("ENTRY")=APCDVSIT,APCDE="E104" D ERR^APCDRV Q
I '$D(^AUPNPAT(Y)) S APCDE("FILE")=9000010,APCDE("ENTRY")=APCDVSIT,APCDE="E109" D ERR^APCDRV Q
I '$D(^DPT(Y)) S APCDE("FILE")=9000010,APCDE("ENTRY")=APCDVSIT,APCDE="E110" D ERR^APCDRV Q
D ^AUPNPAT
I AUPNDOB]"" S X2=AUPNDOB,X1=$P(APCDVREC,U)\1 D ^%DTC S AUPNDAYS=X ; re-set days of age to visit date-dob
I $G(DUZ("AG"))="I"!($G(DUZ("AG")))="" D ^APCDRRQ
K Y,%DT,X,X1,X2
Q
01 ;check .01 field
S X=$P(APCDVREC,U)
S %DT="TRPXN" D ^%DT I X=-1 S APCDE("FILE")=9000010,APCDE("ENTRY")=APCDVSIT,APCDE="E128" D ERR^APCDRV Q
D VSIT01^AUPNVSIT I '$D(X) D I $G(APCDE)]"" Q
.I $P(APCDVREC,U,7)="C",$$DOD^AUPNPAT($P(APCDVREC,U,5))<$P($P(APCDVREC,U),".") Q ;if it is a chart review and after DOD then no error
.S APCDE("FILE")=9000010,APCDE("ENTRY")=APCDVSIT,APCDE="E128" D ERR^APCDRV Q
02 ;
I $P(APCDVREC,U,2)="" S APCDE("FILE")=9000010,APCDE("ENTRY")=APCDVSIT,APCDE="E129" D ERR^APCDRV Q
S X=$P(APCDVREC,U,2)
S %DT="TRXPN" D ^%DT I X=-1 S APCDE("FILE")=9000010,APCDE("ENTRY")=APCDVSIT,APCDE="E129" D ERR^APCDRV
03 ;
I $P(APCDVREC,U,3)="" S APCDE("FILE")=9000010,APCDE("ENTRY")=APCDVSIT,APCDE="E130" D ERR^APCDRV
;I $P(APCDVREC,U,3)="C",$P(APCDVREC,U,8)'=APCDDCHS,'$D(^AUPNVCHS("AD",APCDVSIT)) S APCDE("FILE")=9000010,APCDE("ENTRY")=APCDVSIT,APCDE="E131" D ERR^APCDRV
07 ;
I $P(APCDVREC,U,7)="" S APCDE("FILE")=9000010,APCDE("ENTRY")=APCDVSIT,APCDE="E132" D ERR^APCDRV
08 ;
S APCDCLN=$P(APCDVREC,U,8)
Q:APCDCLN=""
I '$D(^DIC(40.7,APCDCLN,0)) S APCDE("FILE")=9000010,APCDE("ENTRY")=APCDVSIT,APCDE="E133" D ERR^APCDRV
I $P(^DIC(40.7,APCDCLN,0),U,2)="" S APCDE("FILE")=9000010,APCDE("ENTRY")=APCDVSIT,APCDE="E134" D ERR^APCDRV
Q
APCDR001 ; IHS/CMI/LAB - cont. review visit data ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
VISIT ;EP;check fields in visit file
+1 DO 06
+2 DO 05
+3 DO 01
+4 QUIT
+5 ;
06 ;check for valid location of visit and code
+1 SET APCDLDFN=$PIECE(APCDVREC,U,6)
IF APCDLDFN=""
SET APCDE("FILE")=9000010
SET APCDE("ENTRY")=APCDVSIT
SET APCDE="E111"
DO ERR^APCDRV
QUIT
+2 IF '$DATA(^AUTTLOC(APCDLDFN,0))
SET APCDE("FILE")=9000010
SET APCDE("ENTRY")=APCDVSIT
SET APCDE="E112"
DO ERR^APCDRV
QUIT
+3 IF '$DATA(^DIC(4,APCDLDFN,0))
SET APCDE("FILE")=9000010
SET APCDE("ENTRY")=APCDVSIT
SET APCDE="E112"
DO ERR^APCDRV
QUIT
+4 IF $PIECE(^AUTTLOC(APCDLDFN,0),U,10)=""
SET APCDE("FILE")=9000010
SET APCDE("ENTRY")=APCDVSIT
SET APCDE="E113"
DO ERR^APCDRV
QUIT
+5 IF $LENGTH($PIECE(^AUTTLOC(APCDLDFN,0),U,10))'=6
SET APCDE("FILE")=9000010
SET APCDE("ENTRY")=APCDVSIT
SET APCDE="E114"
DO ERR^APCDRV
+6 QUIT
+7 ;
05 ; check patient
+1 SET Y=$PIECE(APCDVREC,U,5)
IF Y=""
SET APCDE("FILE")=9000010
SET APCDE("ENTRY")=APCDVSIT
SET APCDE="E104"
DO ERR^APCDRV
QUIT
+2 IF '$DATA(^AUPNPAT(Y))
SET APCDE("FILE")=9000010
SET APCDE("ENTRY")=APCDVSIT
SET APCDE="E109"
DO ERR^APCDRV
QUIT
+3 IF '$DATA(^DPT(Y))
SET APCDE("FILE")=9000010
SET APCDE("ENTRY")=APCDVSIT
SET APCDE="E110"
DO ERR^APCDRV
QUIT
+4 DO ^AUPNPAT
+5 ; re-set days of age to visit date-dob
IF AUPNDOB]""
SET X2=AUPNDOB
SET X1=$PIECE(APCDVREC,U)\1
DO ^%DTC
SET AUPNDAYS=X
+6 IF $GET(DUZ("AG"))="I"!($GET(DUZ("AG")))=""
DO ^APCDRRQ
+7 KILL Y,%DT,X,X1,X2
+8 QUIT
01 ;check .01 field
+1 SET X=$PIECE(APCDVREC,U)
+2 SET %DT="TRPXN"
DO ^%DT
IF X=-1
SET APCDE("FILE")=9000010
SET APCDE("ENTRY")=APCDVSIT
SET APCDE="E128"
DO ERR^APCDRV
QUIT
+3 DO VSIT01^AUPNVSIT
IF '$DATA(X)
Begin DoDot:1
+4 ;if it is a chart review and after DOD then no error
IF $PIECE(APCDVREC,U,7)="C"
IF $$DOD^AUPNPAT($PIECE(APCDVREC,U,5))<$PIECE($PIECE(APCDVREC,U),".")
QUIT
+5 SET APCDE("FILE")=9000010
SET APCDE("ENTRY")=APCDVSIT
SET APCDE="E128"
DO ERR^APCDRV
QUIT
End DoDot:1
IF $GET(APCDE)]""
QUIT
02 ;
+1 IF $PIECE(APCDVREC,U,2)=""
SET APCDE("FILE")=9000010
SET APCDE("ENTRY")=APCDVSIT
SET APCDE="E129"
DO ERR^APCDRV
QUIT
+2 SET X=$PIECE(APCDVREC,U,2)
+3 SET %DT="TRXPN"
DO ^%DT
IF X=-1
SET APCDE("FILE")=9000010
SET APCDE("ENTRY")=APCDVSIT
SET APCDE="E129"
DO ERR^APCDRV
03 ;
+1 IF $PIECE(APCDVREC,U,3)=""
SET APCDE("FILE")=9000010
SET APCDE("ENTRY")=APCDVSIT
SET APCDE="E130"
DO ERR^APCDRV
+2 ;I $P(APCDVREC,U,3)="C",$P(APCDVREC,U,8)'=APCDDCHS,'$D(^AUPNVCHS("AD",APCDVSIT)) S APCDE("FILE")=9000010,APCDE("ENTRY")=APCDVSIT,APCDE="E131" D ERR^APCDRV
07 ;
+1 IF $PIECE(APCDVREC,U,7)=""
SET APCDE("FILE")=9000010
SET APCDE("ENTRY")=APCDVSIT
SET APCDE="E132"
DO ERR^APCDRV
08 ;
+1 SET APCDCLN=$PIECE(APCDVREC,U,8)
+2 IF APCDCLN=""
QUIT
+3 IF '$DATA(^DIC(40.7,APCDCLN,0))
SET APCDE("FILE")=9000010
SET APCDE("ENTRY")=APCDVSIT
SET APCDE="E133"
DO ERR^APCDRV
+4 IF $PIECE(^DIC(40.7,APCDCLN,0),U,2)=""
SET APCDE("FILE")=9000010
SET APCDE("ENTRY")=APCDVSIT
SET APCDE="E134"
DO ERR^APCDRV
+5 QUIT
