BPCMEAS.m

BPCMEAS ; IHS/OIT/MJL - GUI V MEASUREMENT VISIT CREATION ;

 ;;1.5;BPC;;MAY 26, 2005

 ;;

GETVISIT(BGUARRAY,BPCPIEN,BPCTYPE,BPCVDT,BPCLOC,BPCCAT,BPCMOD,BPCMTYP,BPCMVAL,BPCPROV,BPCEPRV) ;EP CALL

 ;                          FROM REMOTE PROC: BPC MEASVISIT SAVE

 ;BGUARRAY is return array

 ;BPCPIEN is patient IEN

 ;BPCTYPE is VISIT type ex: I FOR IHS

 ;BPCVDT is visit date and time in fm format

 ;BPCLOC is DUZ(2) 

 ;BPCCAT is service category

 ;BPCMOD is flag ex: C is create/add new entry, M is modify entry

 ;BPCMTYP is meas type IEN

 ;BPCMVAL is meas value

 ;BPCPROV is ordering provider IEN

 ;BPCEPRV is encounter provider IEN  usually DUZ

 ;

EN ;ENTRY POINT FOR TESTING

 ;S BPCPIEN=25241,BPCTYPE="I",BPCVDT="3010924.1200"

 ;S BPCLOC=DUZ(2),BPCCAT="A",BPCMOD="C",BPCMTYP="4"

 ;S BPCMVAL="120/88",BPCPROV=2,BPCEPRV=2

 S JOB=$J,XWBWRAP=1,BPCGUI=1

 S BGUARRAY="^XTMP(""BPCMV"","_$J_")"

 K @BGUARRAY

 ;

 ;check patient IEN

 S BPCERR=0

 I $G(BPCPIEN)="" D  Q:BPCERR

 .S ^XTMP("BPCMV",JOB,1)=-1,^(2)="PATIENT IEN NOT SENT!"

 .D KILL

 .S BPCERR=1

 .Q

 ;

 ;check patient

 S BPCERR=0

 I '$D(^AUPNPAT(BPCPIEN,0)) D  Q:BPCERR

 .S ^XTMP("BPCMV",JOB,1)=-1,^XTMP(2)="PATIENT IEN IS NOT DEFINED!"

 .D KILL

 .S BPCERR=1

 .Q

 ;

 ;check for DUZ(2)

 S BPCERR=0

 I 'BPCLOC D  Q:BPCERR

 .S ^XTMP("BPCMV",JOB,1)=-1,^(2)="LOCATION (DUZ(2)) NOT SENT!"

 .D KILL

 .S BPCERR=1

 .Q

 ;

 ;check VISIT TYPE

 S BPCERR=0

 I $G(BPCTYPE)="" D  Q:BPCERR

 .S:'$D(^APCCCTRL(BPCLOC,0)) BPCERR=1

 .S:BPCERR ^XTMP("BPCMV",JOB,1)=-1,^XTMP(2)="VISIT TYPE NOT DEFINED!"

 .Q:BPCERR

 .S BPCTYPE=$S($P($G(^APCCCTRL(BPCLOC,0)),U,4)'="":$P(^(0),U,4),1:"I")

 ;

 ;check for SERVICE CATEGORY

 S BPCERR=0

 I $G(BPCCAT)="" D  Q:BPCERR

 .S ^XTMP("BPCMV",JOB,1)=-1,^(2)="SERVICE CATEGORY NOT SENT!"

 .D KILL

 .S BPCERR=1

 .Q

 ;

 ;check for CREATE/MOD flag

 S BPCERR=0

 I $G(BPCMOD)="" D  Q:BPCERR

 .S ^XTMP("BPCMV",JOB,1)=-1,^(2)="CREATE/MOD FLAG NOT SENT!"

 .D KILL

 .S BPCERR=1

 .Q

 ;

VISIT ;CALLS APCDALV TO CREATE PCC VISIT

 K APCDALVR ;KILL PCC DATA ARRAY

 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 APCDALVR("APCDPAT")=$G(BPCPIEN)

 S APCDALVR("APCDTYPE")=$G(BPCTYPE)

 S APCDALVR("APCDDATE")=$G(BPCVDT)

 S APCDALVR("APCDLOC")=$G(BPCLOC)

 S APCDALVR("APCDCAT")=$G(BPCCAT)

 D ^APCDALV

 ;

 ;if no visit is created

 S BPCERR=0

 I $D(APCDALVR("APCDAFLG")) D  Q:BPCERR

 .S ^XTMP("BPCMV",JOB,1)=-1

 .S ^XTMP("BPCMV",JOB,2)="PCC Visit not created APCDFLG = "

 .S ^XTMP("BPCMV",JOB,2)=^XTMP("BPCMV",JOB,2)_APCDALVR("APCDAFLG")

 .D KILL

 .S BPCERR=1

 .Q

 S BPCVSIT=APCDALVR("APCDVSIT")

 ;

VBUILD ; create APCDALVR array containing the elements to be passed to PCC

 ;assume VISIT created and stored in APCDALVR(""APCDVSIT"")

 ;

 K APCDALVR ;KILL PCC DATA ARRAY

 S APCDALVR("APCDAUTO")="" ;BACKGROUND SILENT VISIT CREATION

 S APCDALVR("AUPNTALK")="" ;BACKGROUND SILENT VISIT CREATION

 S (APCDAUTO,AUPNTALK)=""

 S APCDALVR("APCDVSIT")=BPCVSIT

 S APCDALVR("APCDPAT")=$G(BPCPIEN)

 S BPCERR=0

 I '$D(APCDALVR("APCDVSIT")) D  Q:BPCERR

 .S ^XTMP("BPCMV",JOB,1)=-1,^(2)="PCC Visit not created"

 .D KILL

 .S BPCERR=1

 .Q

 ;

 ;check for ORDERING PROVIDER

 S BPCERR=0

 I '+$G(BPCPROV) D  Q:BPCERR

 .S ^XTMP("BPCMV",JOB,1)=-1,^(2)="INVALID ORDERING PROVIDER SENT!"

 .D KILL

 .S BPCERR=1

 .Q

 ;

 ;check for ORDERING PROVIDER ENTRY IN VA200

 S BPCERR=0

 I '$D(^VA(200,+BPCPROV,0)) D  Q:BPCERR

 .S ^XTMP("BPCMV",JOB,1)=-1,^(2)="ORDERING PROVIDER NOT DEFINED!"

 .D KILL

 .S BPCERR=1

 .Q

 ;

 ;check for ENCOUNTER PROVIDER

 S BPCERR=0

 I '+$G(BPCEPRV) D  Q:BPCERR

 .S ^XTMP("BPCMV",JOB,1)=-1,^(2)="INVALID ENCOUNTER PROVIDER SENT!"

 .D KILL

 .S BPCERR=1

 .Q

 ;

 ;check for ENCOUNTER PROVIDER ENTRY IN VA200

 S BPCERR=0

 I '$D(^VA(200,+BPCEPRV,0)) D  Q:BPCERR

 .S ^XTMP("BPCMV",JOB,1)=-1,^(2)="ENCOUNTER PROVIDER NOT DEFINED!"

 .D KILL

 .S BPCERR=1

 .Q

 ;

 ;set measurement variables

 ;date,meastype,measval previously validated in Client

 S APCDALVR("APCDTVAL")=$G(BPCMVAL)

 S APCDALVR("APCDTTYP")="`"_BPCMTYP

 S APCDALVR("APCDTCDT")=$G(BPCVDT)

 S APCDALVR("APCDTEPR")="`"_BPCEPRV

 S APCDALVR("APCDTPRV")="`"_BPCPROV

 ;

 ;define PCC TEMPLATE and run

 S BPCVFILE="9000010.01" ;pcc V MEAS file number

 S APCDALVR("APCDATMP")="[APCDALVR "_BPCVFILE_" (ADD)]"

 I $G(BPCMOD)="M" S APCDALVR("APCDATMP")="[APCDALVR "_BPCVFILE_" (MOD)]"

 D ^APCDALVR

 ;if no V MEAS is created

 S BPCERR=0

 I $D(APCDALVR("APCDAFLG")) D  Q:BPCERR

 .S ^XTMP("BPCMV",JOB,1)=-1

 .S ^XTMP("BPCMV",JOB,2)="PCC Measurement not created APCDFLG = "

 .S ^XTMP("BPCMV",JOB,2)=^XTMP("BPCMV",JOB,2)_APCDALVR("APCDAFLG")

 .D KILL

 .S BPCERR=1

 .Q

 ;

 S BPCERR=0

 I '$D(APCDALVR("APCDAFLG")) D  Q:BPCERR

 .S ^XTMP("BPCMV",JOB,1)=3

 .S ^XTMP("BPCMV",JOB,2)="PCC Measurement Saved"

 .S ^XTMP("BPCMV",JOB,3)=+$G(APCDALVR("APCDADFN"))

 .D KILL

 .S BPCERR=1

 .Q

 Q

 ;

KILL ;kill variables

 K APCDALVR,BPCPIEN,BPCTIEN,BPCLOC,BPCCAT,BPCCTR,BPCEPRV,BPCERR

 K BPCGUI,BPCL,BPCLOC,BPCMOD,BPCMTYP,BPCVAL,BPCPIEN,BPCPROV,BPCRTN

 K BPCTIEN,BPCTYPE,BPVVDT,BPCVFILE,BPCVSIT,BPCX

 Q

 ;

HELP(BGUARRAY,BPCMTYP) ;EP CALL

 ;     FROM REMOTE PROC: BPC MEASTYPE HELP

 ;

ENH ;ENTRY POINT FOR TESTING HELP

 ;S BPCMTYP=1

 S JOB=$J,BPCGUI=1

 S XWBWRAP=1,BGUARRAY="^XTMP(""BPCMV"","_$J_")"

 K @BGUARRAY

 ;

 ;check MEASUREMENT TYPE

 S BPCERR=0

 I '$G(BPCMTYP) D  Q:BPCERR

 .S ^XTMP("BPCMV",JOB,1)=-1,^XTMP(2)="MEASUREMENT TYPE NOT DEFINED!"

 .D KILL

 .S BPCERR=1

 .Q

 ;

 S BPCERR=0

 I '$D(^AUTTMSR(BPCMTYP,0)) D  Q:BPCERR

 .S ^XTMP("BPCMV",JOB,1)=-1,^XTMP(2)="MEASUREMENT TYPE IEN NOT DEFINED!"

 .D KILL

 .S BPCERR=1

 .Q

 ;

 ;called BPCMTYP already set

 S BPCMTYP="H"_$P(^AUTTMSR(BPCMTYP,0),U,1)

 S:BPCMTYP="HVU" BPCMTYP="HVC"

 I BPCMTYP="HHT" S ^XTMP("BPCMV",JOB,1)=2,^XTMP(2)="Enter height in inches and fractions (64 3/4), or inches and",^XTMP(3)="decimal (64.75)  Height must be between 10 and 90 inches" Q

 I BPCMTYP="HWT" S ^XTMP("BPCMV",JOB,1)=2,^XTMP(2)="Enter weight in LBS and OZs (132 12) or (132 3/4) or (132.75)",^XTMP(3)="Weight must be between 2 and 750 lbs and fractional/decimal part must be a multiple of 1/16 (.0625).i" Q

 ;S ^XTMP("BPCMV",JOB,1)=-1,^XTMP(2)="MEASUREMENT TYPE IEN NOT DEFINED!"

 S BPCRTN="AUPNVMS2"

 S BPCERR=0

 I $T(@BPCMTYP^@BPCRTN)="" D  Q:BPCERR

 .S ^XTMP("BPCMV",JOB,1)=-1,^(2)="MEASUREMENT TYPE HELP NOT AVAILABLE!"

 .S BPCERR=1

 .Q

 ;

 S BPCCTR=1

 S BPCERR=0

 ;

 F BPCX=1:1 D  Q:BPCERR

 .S BPCL=$T(@BPCMTYP+BPCX^@BPCRTN)

 .S:BPCL=""!($P(BPCL,";;",1)'=" ") BPCERR=1

 .Q:BPCERR

 .S ^XTMP("BPCMV",JOB,BPCCTR)=$P(BPCL,";;",2)

 .S BPCCTR=BPCCTR+1

 ;

 S ^XTMP("BPCMV",JOB,.5)=BPCCTR-1

 Q

 ;

VAL(BGUARRAY,BPCMTYP,BPCMVAL) ;EP CALL

 ;     FROM REMOTE PROC: BPC MEASVAL VALIDATE

 ;

ENV ;ENTRY POINT FOR TESTING VALIDATE

 ;S BPCMTYP=4

 ;S BPCMVAL="100/80"

 S JOB=$J,BPCGUI=1

 S XWBWRAP=1,BGUARRAY="^XTMP(""BPCMV"","_$J_")"

 K @BGUARRAY

 ;

 ;check MEASUREMENT VALUE

 S BPCERR=0

 I $G(BPCMVAL)="" D  Q:BPCERR

 .S ^XTMP("BPCMV",JOB,1)=-1,^XTMP(2)="MEASUREMENT VALUE NOT DEFINED!"

 .D KILL

 .S BPCERR=1

 .Q

 ;

 S BPCERR=0

 I '$D(^AUTTMSR(BPCMTYP,0)) D  Q:BPCERR

 .S ^XTMP("BPCMV",JOB,1)=-1,^XTMP(2)="MEASUREMENT TYPE IEN NOT DEFINED!"

 .D KILL

 .S BPCERR=1

 .Q

 ;

 ;called BPCMTYP already set

 S BPCMTYP=$P(^AUTTMSR(BPCMTYP,0),U,1)

 S:BPCMTYP="VU" BPCMTYP="VC"

 S BPCRTN="AUPNVMSR"

 S BPCERR=0

 I $T(@BPCMTYP^@BPCRTN)="" D  Q:BPCERR

 .S ^XTMP("BPCMV",JOB,1)=-1,^(2)="MEASUREMENT VALIDATE NOT AVAILABLE!"

 .S BPCERR=1

 .Q

 ;

 S BPCCTR=1

 S BPCERR=0

 S X=BPCMVAL

 D @BPCMTYP^@BPCRTN

 I '$D(X) D  Q:BPCERR

 .S ^XTMP("BPCMV",JOB,1)=-1,^(2)="MEASUREMENT VALUE IS NOT ACCEPTABLE!"

 .S BPCERR=1

 .Q

 ;

 S ^XTMP("BPCMV",JOB,.5)=2

 S ^XTMP("BPCMV",JOB,1)="INPUT TRANSFORM OK!"

 Q

BPCMEAS   ; IHS/OIT/MJL - GUI V MEASUREMENT VISIT CREATION ;

 +1       ;;1.5;BPC;;MAY 26, 2005

 +2       ;;

GETVISIT(BGUARRAY,BPCPIEN,BPCTYPE,BPCVDT,BPCLOC,BPCCAT,BPCMOD,BPCMTYP,BPCMVAL,BPCPROV,BPCEPRV) ;EP CALL

 +1       ;                          FROM REMOTE PROC: BPC MEASVISIT SAVE

 +2       ;BGUARRAY is return array

 +3       ;BPCPIEN is patient IEN

 +4       ;BPCTYPE is VISIT type ex: I FOR IHS

 +5       ;BPCVDT is visit date and time in fm format

 +6       ;BPCLOC is DUZ(2) 

 +7       ;BPCCAT is service category

 +8       ;BPCMOD is flag ex: C is create/add new entry, M is modify entry

 +9       ;BPCMTYP is meas type IEN

 +10      ;BPCMVAL is meas value

 +11      ;BPCPROV is ordering provider IEN

 +12      ;BPCEPRV is encounter provider IEN  usually DUZ

 +13      ;

EN        ;ENTRY POINT FOR TESTING

 +1       ;S BPCPIEN=25241,BPCTYPE="I",BPCVDT="3010924.1200"

 +2       ;S BPCLOC=DUZ(2),BPCCAT="A",BPCMOD="C",BPCMTYP="4"

 +3       ;S BPCMVAL="120/88",BPCPROV=2,BPCEPRV=2

 +4        SET JOB=$JOB

           SET XWBWRAP=1

           SET BPCGUI=1

 +5        SET BGUARRAY="^XTMP(""BPCMV"","_$JOB_")"

 +6        KILL @BGUARRAY

 +7       ;

 +8       ;check patient IEN

 +9        SET BPCERR=0

 +10       IF $GET(BPCPIEN)=""

               Begin DoDot:1

 +11               SET ^XTMP("BPCMV",JOB,1)=-1

                   SET ^(2)="PATIENT IEN NOT SENT!"

 +12               DO KILL

 +13               SET BPCERR=1

 +14               QUIT 

               End DoDot:1

               IF BPCERR

                   QUIT 

 +15      ;

 +16      ;check patient

 +17       SET BPCERR=0

 +18       IF '$DATA(^AUPNPAT(BPCPIEN,0))

               Begin DoDot:1

 +19               SET ^XTMP("BPCMV",JOB,1)=-1

                   SET ^XTMP(2)="PATIENT IEN IS NOT DEFINED!"

 +20               DO KILL

 +21               SET BPCERR=1

 +22               QUIT 

               End DoDot:1

               IF BPCERR

                   QUIT 

 +23      ;

 +24      ;check for DUZ(2)

 +25       SET BPCERR=0

 +26       IF 'BPCLOC

               Begin DoDot:1

 +27               SET ^XTMP("BPCMV",JOB,1)=-1

                   SET ^(2)="LOCATION (DUZ(2)) NOT SENT!"

 +28               DO KILL

 +29               SET BPCERR=1

 +30               QUIT 

               End DoDot:1

               IF BPCERR

                   QUIT 

 +31      ;

 +32      ;check VISIT TYPE

 +33       SET BPCERR=0

 +34       IF $GET(BPCTYPE)=""

               Begin DoDot:1

 +35               IF '$DATA(^APCCCTRL(BPCLOC,0))

                       SET BPCERR=1

 +36               IF BPCERR

                       SET ^XTMP("BPCMV",JOB,1)=-1

                       SET ^XTMP(2)="VISIT TYPE NOT DEFINED!"

 +37               IF BPCERR

                       QUIT 

 +38               SET BPCTYPE=$SELECT($PIECE($GET(^APCCCTRL(BPCLOC,0)),U,4)'="":$PIECE(^(0),U,4),1:"I")

               End DoDot:1

               IF BPCERR

                   QUIT 

 +39      ;

 +40      ;check for SERVICE CATEGORY

 +41       SET BPCERR=0

 +42       IF $GET(BPCCAT)=""

               Begin DoDot:1

 +43               SET ^XTMP("BPCMV",JOB,1)=-1

                   SET ^(2)="SERVICE CATEGORY NOT SENT!"

 +44               DO KILL

 +45               SET BPCERR=1

 +46               QUIT 

               End DoDot:1

               IF BPCERR

                   QUIT 

 +47      ;

 +48      ;check for CREATE/MOD flag

 +49       SET BPCERR=0

 +50       IF $GET(BPCMOD)=""

               Begin DoDot:1

 +51               SET ^XTMP("BPCMV",JOB,1)=-1

                   SET ^(2)="CREATE/MOD FLAG NOT SENT!"

 +52               DO KILL

 +53               SET BPCERR=1

 +54               QUIT 

               End DoDot:1

               IF BPCERR

                   QUIT 

 +55      ;

VISIT     ;CALLS APCDALV TO CREATE PCC VISIT

 +1       ;KILL PCC DATA ARRAY

           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 APCDALVR("APCDPAT")=$GET(BPCPIEN)

 +7        SET APCDALVR("APCDTYPE")=$GET(BPCTYPE)

 +8        SET APCDALVR("APCDDATE")=$GET(BPCVDT)

 +9        SET APCDALVR("APCDLOC")=$GET(BPCLOC)

 +10       SET APCDALVR("APCDCAT")=$GET(BPCCAT)

 +11       DO ^APCDALV

 +12      ;

 +13      ;if no visit is created

 +14       SET BPCERR=0

 +15       IF $DATA(APCDALVR("APCDAFLG"))

               Begin DoDot:1

 +16               SET ^XTMP("BPCMV",JOB,1)=-1

 +17               SET ^XTMP("BPCMV",JOB,2)="PCC Visit not created APCDFLG = "

 +18               SET ^XTMP("BPCMV",JOB,2)=^XTMP("BPCMV",JOB,2)_APCDALVR("APCDAFLG")

 +19               DO KILL

 +20               SET BPCERR=1

 +21               QUIT 

               End DoDot:1

               IF BPCERR

                   QUIT 

 +22       SET BPCVSIT=APCDALVR("APCDVSIT")

 +23      ;

VBUILD    ; create APCDALVR array containing the elements to be passed to PCC

 +1       ;assume VISIT created and stored in APCDALVR(""APCDVSIT"")

 +2       ;

 +3       ;KILL PCC DATA ARRAY

           KILL APCDALVR

 +4       ;BACKGROUND SILENT VISIT CREATION

           SET APCDALVR("APCDAUTO")=""

 +5       ;BACKGROUND SILENT VISIT CREATION

           SET APCDALVR("AUPNTALK")=""

 +6        SET (APCDAUTO,AUPNTALK)=""

 +7        SET APCDALVR("APCDVSIT")=BPCVSIT

 +8        SET APCDALVR("APCDPAT")=$GET(BPCPIEN)

 +9        SET BPCERR=0

 +10       IF '$DATA(APCDALVR("APCDVSIT"))

               Begin DoDot:1

 +11               SET ^XTMP("BPCMV",JOB,1)=-1

                   SET ^(2)="PCC Visit not created"

 +12               DO KILL

 +13               SET BPCERR=1

 +14               QUIT 

               End DoDot:1

               IF BPCERR

                   QUIT 

 +15      ;

 +16      ;check for ORDERING PROVIDER

 +17       SET BPCERR=0

 +18       IF '+$GET(BPCPROV)

               Begin DoDot:1

 +19               SET ^XTMP("BPCMV",JOB,1)=-1

                   SET ^(2)="INVALID ORDERING PROVIDER SENT!"

 +20               DO KILL

 +21               SET BPCERR=1

 +22               QUIT 

               End DoDot:1

               IF BPCERR

                   QUIT 

 +23      ;

 +24      ;check for ORDERING PROVIDER ENTRY IN VA200

 +25       SET BPCERR=0

 +26       IF '$DATA(^VA(200,+BPCPROV,0))

               Begin DoDot:1

 +27               SET ^XTMP("BPCMV",JOB,1)=-1

                   SET ^(2)="ORDERING PROVIDER NOT DEFINED!"

 +28               DO KILL

 +29               SET BPCERR=1

 +30               QUIT 

               End DoDot:1

               IF BPCERR

                   QUIT 

 +31      ;

 +32      ;check for ENCOUNTER PROVIDER

 +33       SET BPCERR=0

 +34       IF '+$GET(BPCEPRV)

               Begin DoDot:1

 +35               SET ^XTMP("BPCMV",JOB,1)=-1

                   SET ^(2)="INVALID ENCOUNTER PROVIDER SENT!"

 +36               DO KILL

 +37               SET BPCERR=1

 +38               QUIT 

               End DoDot:1

               IF BPCERR

                   QUIT 

 +39      ;

 +40      ;check for ENCOUNTER PROVIDER ENTRY IN VA200

 +41       SET BPCERR=0

 +42       IF '$DATA(^VA(200,+BPCEPRV,0))

               Begin DoDot:1

 +43               SET ^XTMP("BPCMV",JOB,1)=-1

                   SET ^(2)="ENCOUNTER PROVIDER NOT DEFINED!"

 +44               DO KILL

 +45               SET BPCERR=1

 +46               QUIT 

               End DoDot:1

               IF BPCERR

                   QUIT 

 +47      ;

 +48      ;set measurement variables

 +49      ;date,meastype,measval previously validated in Client

 +50       SET APCDALVR("APCDTVAL")=$GET(BPCMVAL)

 +51       SET APCDALVR("APCDTTYP")="`"_BPCMTYP

 +52       SET APCDALVR("APCDTCDT")=$GET(BPCVDT)

 +53       SET APCDALVR("APCDTEPR")="`"_BPCEPRV

 +54       SET APCDALVR("APCDTPRV")="`"_BPCPROV

 +55      ;

 +56      ;define PCC TEMPLATE and run

 +57      ;pcc V MEAS file number

           SET BPCVFILE="9000010.01"

 +58       SET APCDALVR("APCDATMP")="[APCDALVR "_BPCVFILE_" (ADD)]"

 +59       IF $GET(BPCMOD)="M"

               SET APCDALVR("APCDATMP")="[APCDALVR "_BPCVFILE_" (MOD)]"

 +60       DO ^APCDALVR

 +61      ;if no V MEAS is created

 +62       SET BPCERR=0

 +63       IF $DATA(APCDALVR("APCDAFLG"))

               Begin DoDot:1

 +64               SET ^XTMP("BPCMV",JOB,1)=-1

 +65               SET ^XTMP("BPCMV",JOB,2)="PCC Measurement not created APCDFLG = "

 +66               SET ^XTMP("BPCMV",JOB,2)=^XTMP("BPCMV",JOB,2)_APCDALVR("APCDAFLG")

 +67               DO KILL

 +68               SET BPCERR=1

 +69               QUIT 

               End DoDot:1

               IF BPCERR

                   QUIT 

 +70      ;

 +71       SET BPCERR=0

 +72       IF '$DATA(APCDALVR("APCDAFLG"))

               Begin DoDot:1

 +73               SET ^XTMP("BPCMV",JOB,1)=3

 +74               SET ^XTMP("BPCMV",JOB,2)="PCC Measurement Saved"

 +75               SET ^XTMP("BPCMV",JOB,3)=+$GET(APCDALVR("APCDADFN"))

 +76               DO KILL

 +77               SET BPCERR=1

 +78               QUIT 

               End DoDot:1

               IF BPCERR

                   QUIT 

 +79       QUIT 

 +80      ;

KILL      ;kill variables

 +1        KILL APCDALVR,BPCPIEN,BPCTIEN,BPCLOC,BPCCAT,BPCCTR,BPCEPRV,BPCERR

 +2        KILL BPCGUI,BPCL,BPCLOC,BPCMOD,BPCMTYP,BPCVAL,BPCPIEN,BPCPROV,BPCRTN

 +3        KILL BPCTIEN,BPCTYPE,BPVVDT,BPCVFILE,BPCVSIT,BPCX

 +4        QUIT 

 +5       ;

HELP(BGUARRAY,BPCMTYP) ;EP CALL

 +1       ;     FROM REMOTE PROC: BPC MEASTYPE HELP

 +2       ;

ENH       ;ENTRY POINT FOR TESTING HELP

 +1       ;S BPCMTYP=1

 +2        SET JOB=$JOB

           SET BPCGUI=1

 +3        SET XWBWRAP=1

           SET BGUARRAY="^XTMP(""BPCMV"","_$JOB_")"

 +4        KILL @BGUARRAY

 +5       ;

 +6       ;check MEASUREMENT TYPE

 +7        SET BPCERR=0

 +8        IF '$GET(BPCMTYP)

               Begin DoDot:1

 +9                SET ^XTMP("BPCMV",JOB,1)=-1

                   SET ^XTMP(2)="MEASUREMENT TYPE NOT DEFINED!"

 +10               DO KILL

 +11               SET BPCERR=1

 +12               QUIT 

               End DoDot:1

               IF BPCERR

                   QUIT 

 +13      ;

 +14       SET BPCERR=0

 +15       IF '$DATA(^AUTTMSR(BPCMTYP,0))

               Begin DoDot:1

 +16               SET ^XTMP("BPCMV",JOB,1)=-1

                   SET ^XTMP(2)="MEASUREMENT TYPE IEN NOT DEFINED!"

 +17               DO KILL

 +18               SET BPCERR=1

 +19               QUIT 

               End DoDot:1

               IF BPCERR

                   QUIT 

 +20      ;

 +21      ;called BPCMTYP already set

 +22       SET BPCMTYP="H"_$PIECE(^AUTTMSR(BPCMTYP,0),U,1)

 +23       IF BPCMTYP="HVU"

               SET BPCMTYP="HVC"

 +24       IF BPCMTYP="HHT"

               SET ^XTMP("BPCMV",JOB,1)=2

               SET ^XTMP(2)="Enter height in inches and fractions (64 3/4), or inches and"

               SET ^XTMP(3)="decimal (64.75)  Height must be between 10 and 90 inches"

               QUIT 

 +25       IF BPCMTYP="HWT"

               SET ^XTMP("BPCMV",JOB,1)=2

               SET ^XTMP(2)="Enter weight in LBS and OZs (132 12) or (132 3/4) or (132.75)"

               SET ^XTMP(3)="Weight must be between 2 and 750 lbs and fractional/decimal part must be a multiple of 1/16 (.0625).i"

               QUIT 

 +26      ;S ^XTMP("BPCMV",JOB,1)=-1,^XTMP(2)="MEASUREMENT TYPE IEN NOT DEFINED!"

 +27       SET BPCRTN="AUPNVMS2"

 +28       SET BPCERR=0

 +29       IF $TEXT(@BPCMTYP^@BPCRTN)=""

               Begin DoDot:1

 +30               SET ^XTMP("BPCMV",JOB,1)=-1

                   SET ^(2)="MEASUREMENT TYPE HELP NOT AVAILABLE!"

 +31               SET BPCERR=1

 +32               QUIT 

               End DoDot:1

               IF BPCERR

                   QUIT 

 +33      ;

 +34       SET BPCCTR=1

 +35       SET BPCERR=0

 +36      ;

 +37       FOR BPCX=1:1

               Begin DoDot:1

 +38               SET BPCL=$TEXT(@BPCMTYP+BPCX^@BPCRTN)

 +39               IF BPCL=""!($PIECE(BPCL,";;",1)'=" ")

                       SET BPCERR=1

 +40               IF BPCERR

                       QUIT 

 +41               SET ^XTMP("BPCMV",JOB,BPCCTR)=$PIECE(BPCL,";;",2)

 +42               SET BPCCTR=BPCCTR+1

               End DoDot:1

               IF BPCERR

                   QUIT 

 +43      ;

 +44       SET ^XTMP("BPCMV",JOB,.5)=BPCCTR-1

 +45       QUIT 

 +46      ;

VAL(BGUARRAY,BPCMTYP,BPCMVAL) ;EP CALL

 +1       ;     FROM REMOTE PROC: BPC MEASVAL VALIDATE

 +2       ;

ENV       ;ENTRY POINT FOR TESTING VALIDATE

 +1       ;S BPCMTYP=4

 +2       ;S BPCMVAL="100/80"

 +3        SET JOB=$JOB

           SET BPCGUI=1

 +4        SET XWBWRAP=1

           SET BGUARRAY="^XTMP(""BPCMV"","_$JOB_")"

 +5        KILL @BGUARRAY

 +6       ;

 +7       ;check MEASUREMENT VALUE

 +8        SET BPCERR=0

 +9        IF $GET(BPCMVAL)=""

               Begin DoDot:1

 +10               SET ^XTMP("BPCMV",JOB,1)=-1

                   SET ^XTMP(2)="MEASUREMENT VALUE NOT DEFINED!"

 +11               DO KILL

 +12               SET BPCERR=1

 +13               QUIT 

               End DoDot:1

               IF BPCERR

                   QUIT 

 +14      ;

 +15       SET BPCERR=0

 +16       IF '$DATA(^AUTTMSR(BPCMTYP,0))

               Begin DoDot:1

 +17               SET ^XTMP("BPCMV",JOB,1)=-1

                   SET ^XTMP(2)="MEASUREMENT TYPE IEN NOT DEFINED!"

 +18               DO KILL

 +19               SET BPCERR=1

 +20               QUIT 

               End DoDot:1

               IF BPCERR

                   QUIT 

 +21      ;

 +22      ;called BPCMTYP already set

 +23       SET BPCMTYP=$PIECE(^AUTTMSR(BPCMTYP,0),U,1)

 +24       IF BPCMTYP="VU"

               SET BPCMTYP="VC"

 +25       SET BPCRTN="AUPNVMSR"

 +26       SET BPCERR=0

 +27       IF $TEXT(@BPCMTYP^@BPCRTN)=""

               Begin DoDot:1

 +28               SET ^XTMP("BPCMV",JOB,1)=-1

                   SET ^(2)="MEASUREMENT VALIDATE NOT AVAILABLE!"

 +29               SET BPCERR=1

 +30               QUIT 

               End DoDot:1

               IF BPCERR

                   QUIT 

 +31      ;

 +32       SET BPCCTR=1

 +33       SET BPCERR=0

 +34       SET X=BPCMVAL

 +35       DO @BPCMTYP^@BPCRTN

 +36       IF '$DATA(X)

               Begin DoDot:1

 +37               SET ^XTMP("BPCMV",JOB,1)=-1

                   SET ^(2)="MEASUREMENT VALUE IS NOT ACCEPTABLE!"

 +38               SET BPCERR=1

 +39               QUIT 

               End DoDot:1

               IF BPCERR

                   QUIT 

 +40      ;

 +41       SET ^XTMP("BPCMV",JOB,.5)=2

 +42       SET ^XTMP("BPCMV",JOB,1)="INPUT TRANSFORM OK!"

 +43       QUIT