BPCPCCUP ; IHS/OIT/MJL - GUI V FILE VISIT CREATION ;
;;1.5;BPC;;MAY 26, 2005
;;
EN(BPCARRAY,BPCVFILE,BPCUPDF,BPCPARM,BPCRTN) ;EP CALL
D
.D PRECHECK Q:BPCERR'=""
.D INIT
.D PARSE I BPCUPDF="C" D VISITCKS Q:BPCERR'=""
.I BPCRTN'="" D @$TR(BPCRTN,"|","^") Q:BPCERR'=""
.D UPDATE
I BPCERR'="" D ERROR(BPCERR)
D KILL
Q
;
INIT ;
K APCDALVR
K X,Y,DINUM,DLAYGO,DR,DIC,DA,D0,DIU,DIW,DIY,DIV ; KILL FILEMAN VAR
S APCDALVR("APCDAUTO")="" ;BACKGROUND SILENT VISIT CREATION
S APCDALVR("AUPNTALK")="" ;BACKGROUND SILENT VISIT CREATION
S (APCDAUTO,AUPNTALK)=""
S BPCRTN=$G(BPCRTN)
Q
;
PARSE ;
F BPCN=1:1:$L(BPCPARM,$C(30)) S BPCVAL=$P(BPCPARM,$C(30),BPCN),APCDALVR("APCD"_$P(BPCVAL,$C(20)))=$P(BPCVAL,$C(20),2)
Q
;
UPDATE ;
D
.I BPCUPDF="C" D ^APCDALV I $G(APCDALVR("APCDAFLG"))'="" S BPCERR="PCC Visit not created" Q
.S APCDALVR("APCDATMP")="[APCDALVR "_BPCVFILE_" ("_$S(BPCUPDF="C":"ADD",1:"MOD")_")]"
.I '$D(APCDALVR("APCDVSIT")),$G(APCDALVR("APCDADFN")) S APCDALVR("APCDVSIT")=$P(@$P(^DIC(BPCVFILE,0,"GL"),"(")@(APCDALVR("APCDADFN"),0),U,3),APCDALVR("APCDLOOK")=APCDALVR("APCDADFN")
.I '$G(APCDALVR("APCDVSIT")) S BPCERR=$P(^DIC(BPCVFILE,0),U)_" not updated - Visit IEN not set!" Q
.D ^APCDALVR
.;D ^BPCEDM
.I $G(APCDALVR("APCDAFLG"))'="" S BPCERR=$P(^DIC(BPCVFILE,0),U)_" not updated" Q
I BPCERR'="" S:$G(APCDALVR("APCDAFLG"))'="" BPCERR=BPCERR_" - "_APCDALVR("APCDAFLG") S:$G(APCDAFLG("ERR"))'="" BPCERR=BPCERR_$C(13,10)_APCDAFLG("ERR") Q
D MSG("2"_$C(30)_APCDALVR("APCDVSIT")_$C(30)_APCDALVR("APCD"_$S(BPCUPDF="C":"ADFN",1:"LOOK")))
Q
;
ERROR(BPCX) ;
D MSG("-1"_$C(30)_BPCX)
Q
;
MSG(BPCX) ;
S BPCARRAY=BPCX
Q
;
PRECHECK ;
;check for FILE NAME
S BPCERR=""
I $G(BPCVFILE)="" S BPCERR="FILE NAME NOT SENT!" Q
S:'BPCVFILE BPCVFILE=$O(^DIC("B",BPCVFILE,""))
;check for CREATE/MOD flag
I $G(BPCUPDF)="" S BPCERR="CREATE/MOD FLAG NOT SENT!" Q
;check for PCC parameter/value pairs string
I $G(BPCPARM)="" S BPCERR="NO PARAMETERS SET" Q
Q
;
VISITCKS ;
;check patient IEN
I $G(APCDALVR("APCDPAT"))="" S BPCERR="PATIENT IEN NOT SENT!" Q
;check patient
I '$D(^AUPNPAT($P(APCDALVR("APCDPAT"),"`",2),0)) S BPCERR="PATIENT ENTRY IS NOT DEFINED!" Q
;check for DUZ(2)
I $G(APCDALVR("APCDLOC"))="" S BPCERR="LOCATION (DUZ(2)) NOT SENT!" Q
;Set VISIT TYPE
I $G(APCDALVR("APCDTYPE"))="" S APCDALVR("APCDTYPE")=$P($G(^APCCCTRL(APCDALVR("APCDLOC"),0)),U,4) S:APCDALVR("APCDTYPE")="" APCDALVR("APCDTYPE")="I"
;check for good visit type
I "^I^C^T^O^6^V^P^U^S^"'[U_APCDALVR("APCDTYPE")_U S BPCERR="VISIT TYPE NOT DEFINED!" Q
;check for SERVICE CATEGORY
I $G(APCDALVR("APCDCAT"))="" S BPCERR="SERVICE CATEGORY NOT SENT!" Q
I "^A^H^I^C^T^N^S^O^E^R^D^X^"'[U_APCDALVR("APCDCAT")_U S BPCERR="SERVICE CATEGORY NOT DEFINED!" Q
;check for VISIT DATE
I $G(APCDALVR("APCDDATE"))="" S BPCERR="VISIT DATE NOT SENT!" Q
;check for provider
;I $G(APCDALVR("APCDTPRV"))="" S BPCERR="PROVIDER NOT SENT!" Q
;check for ORDERING PROVIDER ENTRY IN VA200
I $G(APCDALVR("APCDTPRO"))'="" S BPCERR=$$PROVCK($P(APCDALVR("APCDTPRO"),"`",2),.05) Q:BPCERR'=""
;check for ORDERING PROVIDER ENTRY IN VA200
I $G(APCDALVR("APCDTPRV"))'="" S BPCERR=$$PROVCK($P(APCDALVR("APCDTPRV"),"`",2),1202) Q:BPCERR'=""
;check for ENCOUNTER PROVIDER
;I $G(APCDALVR("APCDTEPR"))="" S BPCERR="INVALID ENCOUNTER PROVIDER SENT!" Q
;check for ENCOUNTER PROVIDER ENTRY IN VA200
I $G(APCDALVR("APCDTEPR"))'="" S BPCERR=$$PROVCK($P(APCDALVR("APCDTEPR"),"`",2),1204) Q:BPCERR'=""
Q
;
PROVCK(BPCX,BPCFLD) ;
;Provider check
I $P($P($G(^DD(BPCVFILE,BPCFLD,0)),U,2),"'",1)["P200" Q:$D(^VA(200,BPCX,0)) "" Q $P(^DD(BPCVFILE,BPCFLD,0),U,1)_" NOT DEFINED IN THE NEW PERSON FILE!"
S BPCX=$G(^DIC(16,BPCX,"A3")) I BPCX S BPCX=$P($G(^VA(200,BPCX,0)),U,16) I BPCX,$D(^DIC(6,BPCX,0)) Q ""
Q "No entry in Provider file for the "_$P(^DD(BPCVFILE,BPCFLD,0),U,1)_" field entry"
;
KILL ;
K APCDALVR,BPCPARM,BPCERR,BPCVAL
Q
BPCPCCUP ; IHS/OIT/MJL - GUI V FILE VISIT CREATION ;
+1 ;;1.5;BPC;;MAY 26, 2005
+2 ;;
EN(BPCARRAY,BPCVFILE,BPCUPDF,BPCPARM,BPCRTN) ;EP CALL
+1 Begin DoDot:1
+2 DO PRECHECK
IF BPCERR'=""
QUIT
+3 DO INIT
+4 DO PARSE
IF BPCUPDF="C"
DO VISITCKS
IF BPCERR'=""
QUIT
+5 IF BPCRTN'=""
DO @$TRANSLATE(BPCRTN,"|","^")
IF BPCERR'=""
QUIT
+6 DO UPDATE
End DoDot:1
+7 IF BPCERR'=""
DO ERROR(BPCERR)
+8 DO KILL
+9 QUIT
+10 ;
INIT ;
+1 KILL APCDALVR
+2 ; KILL FILEMAN VAR
KILL X,Y,DINUM,DLAYGO,DR,DIC,DA,D0,DIU,DIW,DIY,DIV
+3 ;BACKGROUND SILENT VISIT CREATION
SET APCDALVR("APCDAUTO")=""
+4 ;BACKGROUND SILENT VISIT CREATION
SET APCDALVR("AUPNTALK")=""
+5 SET (APCDAUTO,AUPNTALK)=""
+6 SET BPCRTN=$GET(BPCRTN)
+7 QUIT
+8 ;
PARSE ;
+1 FOR BPCN=1:1:$LENGTH(BPCPARM,$CHAR(30))
SET BPCVAL=$PIECE(BPCPARM,$CHAR(30),BPCN)
SET APCDALVR("APCD"_$PIECE(BPCVAL,$CHAR(20)))=$PIECE(BPCVAL,$CHAR(20),2)
+2 QUIT
+3 ;
UPDATE ;
+1 Begin DoDot:1
+2 IF BPCUPDF="C"
DO ^APCDALV
IF $GET(APCDALVR("APCDAFLG"))'=""
SET BPCERR="PCC Visit not created"
QUIT
+3 SET APCDALVR("APCDATMP")="[APCDALVR "_BPCVFILE_" ("_$SELECT(BPCUPDF="C":"ADD",1:"MOD")_")]"
+4 IF '$DATA(APCDALVR("APCDVSIT"))
IF $GET(APCDALVR("APCDADFN"))
SET APCDALVR("APCDVSIT")=$PIECE(@$PIECE(^DIC(BPCVFILE,0,"GL"),"(")@(APCDALVR("APCDADFN"),0),U,3)
SET APCDALVR("APCDLOOK")=APCDALVR("APCDADFN")
+5 IF '$GET(APCDALVR("APCDVSIT"))
SET BPCERR=$PIECE(^DIC(BPCVFILE,0),U)_" not updated - Visit IEN not set!"
QUIT
+6 DO ^APCDALVR
+7 ;D ^BPCEDM
+8 IF $GET(APCDALVR("APCDAFLG"))'=""
SET BPCERR=$PIECE(^DIC(BPCVFILE,0),U)_" not updated"
QUIT
End DoDot:1
+9 IF BPCERR'=""
IF $GET(APCDALVR("APCDAFLG"))'=""
SET BPCERR=BPCERR_" - "_APCDALVR("APCDAFLG")
IF $GET(APCDAFLG("ERR"))'=""
SET BPCERR=BPCERR_$CHAR(13,10)_APCDAFLG("ERR")
QUIT
+10 DO MSG("2"_$CHAR(30)_APCDALVR("APCDVSIT")_$CHAR(30)_APCDALVR("APCD"_$SELECT(BPCUPDF="C":"ADFN",1:"LOOK")))
+11 QUIT
+12 ;
ERROR(BPCX) ;
+1 DO MSG("-1"_$CHAR(30)_BPCX)
+2 QUIT
+3 ;
MSG(BPCX) ;
+1 SET BPCARRAY=BPCX
+2 QUIT
+3 ;
PRECHECK ;
+1 ;check for FILE NAME
+2 SET BPCERR=""
+3 IF $GET(BPCVFILE)=""
SET BPCERR="FILE NAME NOT SENT!"
QUIT
+4 IF 'BPCVFILE
SET BPCVFILE=$ORDER(^DIC("B",BPCVFILE,""))
+5 ;check for CREATE/MOD flag
+6 IF $GET(BPCUPDF)=""
SET BPCERR="CREATE/MOD FLAG NOT SENT!"
QUIT
+7 ;check for PCC parameter/value pairs string
+8 IF $GET(BPCPARM)=""
SET BPCERR="NO PARAMETERS SET"
QUIT
+9 QUIT
+10 ;
VISITCKS ;
+1 ;check patient IEN
+2 IF $GET(APCDALVR("APCDPAT"))=""
SET BPCERR="PATIENT IEN NOT SENT!"
QUIT
+3 ;check patient
+4 IF '$DATA(^AUPNPAT($PIECE(APCDALVR("APCDPAT"),"`",2),0))
SET BPCERR="PATIENT ENTRY IS NOT DEFINED!"
QUIT
+5 ;check for DUZ(2)
+6 IF $GET(APCDALVR("APCDLOC"))=""
SET BPCERR="LOCATION (DUZ(2)) NOT SENT!"
QUIT
+7 ;Set VISIT TYPE
+8 IF $GET(APCDALVR("APCDTYPE"))=""
SET APCDALVR("APCDTYPE")=$PIECE($GET(^APCCCTRL(APCDALVR("APCDLOC"),0)),U,4)
IF APCDALVR("APCDTYPE")=""
SET APCDALVR("APCDTYPE")="I"
+9 ;check for good visit type
+10 IF "^I^C^T^O^6^V^P^U^S^"'[U_APCDALVR("APCDTYPE")_U
SET BPCERR="VISIT TYPE NOT DEFINED!"
QUIT
+11 ;check for SERVICE CATEGORY
+12 IF $GET(APCDALVR("APCDCAT"))=""
SET BPCERR="SERVICE CATEGORY NOT SENT!"
QUIT
+13 IF "^A^H^I^C^T^N^S^O^E^R^D^X^"'[U_APCDALVR("APCDCAT")_U
SET BPCERR="SERVICE CATEGORY NOT DEFINED!"
QUIT
+14 ;check for VISIT DATE
+15 IF $GET(APCDALVR("APCDDATE"))=""
SET BPCERR="VISIT DATE NOT SENT!"
QUIT
+16 ;check for provider
+17 ;I $G(APCDALVR("APCDTPRV"))="" S BPCERR="PROVIDER NOT SENT!" Q
+18 ;check for ORDERING PROVIDER ENTRY IN VA200
+19 IF $GET(APCDALVR("APCDTPRO"))'=""
SET BPCERR=$$PROVCK($PIECE(APCDALVR("APCDTPRO"),"`",2),.05)
IF BPCERR'=""
QUIT
+20 ;check for ORDERING PROVIDER ENTRY IN VA200
+21 IF $GET(APCDALVR("APCDTPRV"))'=""
SET BPCERR=$$PROVCK($PIECE(APCDALVR("APCDTPRV"),"`",2),1202)
IF BPCERR'=""
QUIT
+22 ;check for ENCOUNTER PROVIDER
+23 ;I $G(APCDALVR("APCDTEPR"))="" S BPCERR="INVALID ENCOUNTER PROVIDER SENT!" Q
+24 ;check for ENCOUNTER PROVIDER ENTRY IN VA200
+25 IF $GET(APCDALVR("APCDTEPR"))'=""
SET BPCERR=$$PROVCK($PIECE(APCDALVR("APCDTEPR"),"`",2),1204)
IF BPCERR'=""
QUIT
+26 QUIT
+27 ;
PROVCK(BPCX,BPCFLD) ;
+1 ;Provider check
+2 IF $PIECE($PIECE($GET(^DD(BPCVFILE,BPCFLD,0)),U,2),"'",1)["P200"
IF $DATA(^VA(200,BPCX,0))
QUIT ""
QUIT $PIECE(^DD(BPCVFILE,BPCFLD,0),U,1)_" NOT DEFINED IN THE NEW PERSON FILE!"
+3 SET BPCX=$GET(^DIC(16,BPCX,"A3"))
IF BPCX
SET BPCX=$PIECE($GET(^VA(200,BPCX,0)),U,16)
IF BPCX
IF $DATA(^DIC(6,BPCX,0))
QUIT ""
+4 QUIT "No entry in Provider file for the "_$PIECE(^DD(BPCVFILE,BPCFLD,0),U,1)_" field entry"
+5 ;
KILL ;
+1 KILL APCDALVR,BPCPARM,BPCERR,BPCVAL
+2 QUIT
