BPCPCCUP.m

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