BSDX41.m

BSDX41 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;

 ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010

 ;

 ;return Health Summary output

HS(BSDXY,DFN) ;Health Summary

 ;  DFN  = ien of VA PATIENT (^DPT) file 2

 ;Called by BSDX HEALTH SUMMARY remote procedure

 N BSDXI,BSDXSPSG

 D ^XBKVAR S X="ERROR^BSDXERR",@^%ZOSF("TRAP")

 S BSDXI=0

 K ^BSDXTMP($J)

 S BSDXY="^BSDXTMP("_$J_")"

 S ^BSDXTMP($J,0)="T00080ERRORID"_$C(30)

 I '+DFN D ERR^BSDXERR("Invalid Patient ID.") Q

 I '$D(^DPT(DFN,0)) D ERR^BSDXERR("Invalid Patient ID.") Q

 S APCHSPAT=$O(^AUPNPAT("B",DFN,0))

 I '+APCHSPAT D ERR^BSDXERR("Invalid Patient ID.") Q

 I $D(^DISV(DUZ,"APCHSCTL(")) S APCHSTYP=^DISV(DUZ,"APCHSCTL(")

 I $G(APCHSTYP)="",+$P($G(^APCCCTRL(DUZ(2),0)),U,3) S APCHSTYP=$P(^APCCCTRL(DUZ(2),0),U,3)

 I $G(APCHSTYP)="" D ERR^BSDXERR("Health Summary Type not defined in PCC Master Control file.") Q

 D SUPSEGS(.BSDXSPSG)

 ;

 S ^BSDXTMP($J,0)="T10000TEXT"_$C(30)

 S APCHSCKP="Q:$D(APCHSQIT)  S APCHSNPG=0 I $Y>(IOSL-3) "

 S APCHSBRK="D BREAK^BSDX41"

 S APCHSCVD="S:Y]"""" Y=+Y,Y=$E(Y,4,5)_""/""_$S($E(Y,6,7):$E(Y,6,7)_""/"",1:"""")_$E(Y,2,3)"

 S:'$G(IO) IO="|TRM|:|"_$J

 S:'$G(IOM) IOM=80

 S:'$G(IOSL) IOSL=24

 ;collect header lines

 S %="" D NOW^%DTC S X=% X ^DD("FUNC",2,1) S APCHSTIM=X

 ;***** CONFIDENTIAL PATIENT INFORMATION --  DATE/TIME **************

 S APCHSHDR="CONFIDENTIAL PATIENT INFORMATION -- "_$$FMTE^XLFDT(DT,5)_$J(APCHSTIM,9)_"  ["_$P(^VA(200,DUZ,0),U,2)_"]"

 S X="",$P(X,"*",((80-6-$L(APCHSHDR))\2)+1)="*"

 S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=X_" "_APCHSHDR_" "_X_$C(30)

 S APCHSHD2=$P(^DPT(APCHSPAT,0),U)_" #"_$$HRN^AUPNPAT(APCHSPAT,DUZ(2))_" "_$$CWAD^AUPNLKID(APCHSPAT)_"("_$P(^APCHSCTL(APCHSTYP,0),U)_" SUMMARY)"  ;pg "_APCHSPG

 S X="",$P(X,"*",((80-6-$L(APCHSHD2))\2)+1)="*"

 S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=X_" "_APCHSHD2_" "_X_$C(30) S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=$C(30)

 ;get segment data

 K APCHSQIT

 S BSDXQIET=1

 S APCHSEGN="",APCHSQ=""

 F  S APCHSEGN=$O(^APCHSCTL(APCHSTYP,1,"B",APCHSEGN)) Q:APCHSEGN=""  D

 . S APCHSEGT=$O(^APCHSCTL(APCHSTYP,1,"B",APCHSEGN,""))

 . D SEGMNT Q:$D(APCHSQIT)

 S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=$C(31)

 Q

 ;

SEGMNT ; OUTPUT A SEGMENT TYPE

 S APCHSN=^APCHSCTL(APCHSTYP,1,APCHSEGT,0)

 S APCHSEGC=$P(APCHSN,U,2),APCHSEGH=$P(APCHSN,U,5)

 S APCHSEGP=^APCHSCMP(APCHSEGC,0)

 S APCHSEGC=$P(APCHSEGP,U,2)

 Q:'$G(BSDXSPSG($P(APCHSEGC,";",1),$P(APCHSEGC,";",2)))  ;check if segment converted

 S $P(APCHSEGC,";",2)="BSDX41"

 I APCHSEGH="" S APCHSVAR=$P(APCHSEGP,U,4) S:APCHSVAR]"" APCHSEGH=APCHSVAR

 I APCHSEGH="" S APCHSEGH=$P(APCHSEGP,U,1)

 S APCHSVAR=$P(APCHSEGP,U,5) I APCHSVAR]"",$D(^XUSEC(APCHSVAR,DUZ))[0 Q

 S APCHSN=^APCHSCTL(APCHSTYP,1,APCHSEGT,0) S APCHSNDM=$P(APCHSN,U,3),APCHSDLM=$P(APCHSN,U,4) S:APCHSNDM="" APCHSNDM=-1 ;S:APCHSNDM>0 APCHSNDM=APCHSNDM+1

 ;LIMIT OF TIME OR VISITS

 S APCHSDLS=""

 I APCHSDLM?1N.N!(APCHSDLM?1N.N1"D") S APCHSDLS=+APCHSDLM_" day"

 S:APCHSDLM?1N.N1"M" APCHSDLS=+APCHSDLM_" month",APCHSDLM=+APCHSDLM*30

 S:APCHSDLM?1N.N1"Y" APCHSDLS=+APCHSDLM_" year",APCHSDLM=+APCHSDLM*365

 S APCHSDLM=+APCHSDLM

 S:+APCHSDLS>1 APCHSDLS=APCHSDLS_"s"

 S APCHSEGL="" I APCHSNDM>0!(APCHSDLM>0) S APCHSEGL=" (max "_$S(APCHSNDM>0:APCHSNDM_$S(APCHSNDM=1:" visit",1:" visits")_$S(APCHSDLM>0:" or ",1:""),1:"")_$S(APCHSDLM>0:APCHSDLS,1:"")_")"

 K APCHSDLS,APCHSN

 I APCHSDLM'>0 S APCHSDLM=9999999

 E  S X1=DT,X2=-APCHSDLM D C^%DTC S APCHSDLM=9999999-X K X1,X2

 D @($P(APCHSEGC,";",1)_U_$P(APCHSEGC,";",2))

 Q

 ;

HEADER ;ENTRY POINT

 ;******* KETCHUP,LOIS  (CMED SUMMARY)  pg. 1 ********************

 S APCHSPG=APCHSPG+1

 S APCHSHD2=$P(^DPT(APCHSPAT,0),U)_" #"_$$HRN^AUPNPAT(APCHSPAT,DUZ(2))_" "_$$CWAD^AUPNLKID(APCHSPAT)_"("_$P(^APCHSCTL(APCHSTYP,0),U)_" SUMMARY)  pg "_APCHSPG  ;IHS/ANMC/LJF 4/30/99

 S APCHSP="",$P(APCHSP,"*",((IOM-6-$L(APCHSHD2))\2)+1)="*",APCHSP=APCHSP_" "_APCHSHD2_" "_APCHSP

 S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=$C(30) S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=APCHSHDR_$C(30) S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=APCHSP_$C(30)

 Q

 ;

BREAK ;ENTRY POINT

 ;APCHSEGH IS THE COMPONENT TYPE FROM ^APCHSCMP, FROM SEGMNT ABOVE

 ;------- MEDICATIONS --------------------

 N QF

 S APCHSP="",$P(APCHSP,"-",+$G(IOM)-3-$L(APCHSEGH_APCHSEGL)/2)="",APCHSP=APCHSP_" "_APCHSEGH_APCHSEGL_" "_APCHSP

 I $Y'>(IOSL-5) D

 . S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=$C(30) S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=APCHSP_$C(30) S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=$C(30)

 . S QF=1

 I +$G(QF) Q

 S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=$C(30)

 X APCHSCKP

 Q

 ;

SUPSEGS(BSDXSPSG) ;build array of supported segments

 K BSDXSPSG

 ; BSDXSPSG(<TAG>,<ORIG ROUTINE>)=1

 S BSDXSPSG("ALLRG","APCHGMTS")=1    ;allergies

 S BSDXSPSG("DEMOG","APCHS1")=1      ;patient demographics

 S BSDXSPSG("EYERX","APCHS8A")=1     ;eye glass prescriptions

 S BSDXSPSG("FLOW","APCHS12")=1      ;flow sheet production

 S BSDXSPSG("HFACT","APCHS4A")=1     ;health factors

 S BSDXSPSG("HOS","APCHS6")=1        ;history of surgery

 S BSDXSPSG("INHOSP","APCHS2B")=1    ;in hospital encounters

 S BSDXSPSG("IMMUN","APCHS2")=1      ;immunizations

 S BSDXSPSG("INPT","APCHS2C")=1      ;hospitalization encounters

 S BSDXSPSG("INS","APCHS5")=1        ;insurance

 S BSDXSPSG("MCIS","APCHS9")=1       ;managed care MIS

 S BSDXSPSG("MEASP","APCHS2A")=1     ;measurement panels

 S BSDXSPSG("MEDSCURR","APCHS7")=1   ;current meds

 S BSDXSPSG("MRE","APCHS3C")=1       ;most recent examination

 S BSDXSPSG("MRL","APCHS3A")=1       ;most recent lab

 S BSDXSPSG("MRPTED","APCHS10")=1    ;most recent patient education

 S BSDXSPSG("MRR","APCHS3C")=1       ;most recent radiology

 S BSDXSPSG("OUTPT","APCHS2B")=1     ;outpatient encounters

 S BSDXSPSG("PROBA","APCHS40")=1     ;allergy problems

 S BSDXSPSG("REPHX","APCHS8")=1      ;reproductive history

 S BSDXSPSG("SCHENC","APCHS2D")=1    ;scheduled encounters

 ;S BSDXSPSG("SURV","APCHS11")=1      ;surveillance hard code   ;not supported yet; appears to use routines in APCHM series;

 S BSDXSPSG("TRTMT","APCHS8")=1      ;treatments

 ;these are not in the test scenario and have not been tested

 ;S BSDXSPSG("BIRTHM","APCHS8")=1     ;birth measurements*

 ;S BSDXSPSG("EKG","APCHS8A")=1       ;EKG summary*

 ;S BSDXSPSG("MEAS","APCHS2")=1       ;measurements*

 ;S BSDXSPSG("MEDSALL","APCHS7")=1    ;all meds*

 ;S BSDXSPSG("MEDSCHRN","APCHS7")=1   ;chronic meds*

 ;S BSDXSPSG("MEDSCHR1","APCHS7")=1   ;chronic meds; not DC'd*

 ;S BSDXSPSG("MEDSNDUP","APCHS7")=1   ;all meds, not duplicated*

 ;S BSDXSPSG("OFFHX","APCHS8")=1      ;offspring history*

 ;S BSDXSPSG("PTED","APCHS10")=1      ;patient education

 Q

 ;

ALLRG ;allergies

 G ALLRG^BSDX41C

BIRTHM ;birth measurements

 G BIRTHM^BSDX41E

DEMOG ;patient demographics

 G DEMOG^BSDX41A

EKG   ;EKG summary

 G EKG^BSDX41D

EYERX ;eye glass perscriptions

 G EYERX^BSDX41D

FLOW   ;flow sheet production

 G FLOW^BSDX41N

HFACT  ;health factors

 G HFACT^BSDX41B

HOS    ;history of surgery

 G HOS^BSDX41F

INHOSP ;InHospital Encounters

 G INHOSP^BSDX41I

INPT   ;hospitalization encounters

 G INPT^BSDX41I

IMMUN ;immunizations

 G IMMUN^BSDX41H

INS   ;insurance

 G INS^BSDX41B

MCIS  ;managed care MIS

 G MCIS^BSDX41J

MEAS  ;measurements

 G MEAS^BSDX41H

MEASP ;measurement panels

 G MEASP^BSDX41D

MEDSALL  ;all meds

 G MEDSALL^BSDX41G

MEDSCHRN ;chronic meds

 G MEDSCHRN^BSDX41G

MEDSCHR1 ;chronic meds; not DC'd

 G MEDSCHR1^BSDX41G

MEDSCURR ;current meds

 G MEDSCURR^BSDX41G

MEDSNDUP ;all meds; non duplicated

 G MEDSNDUP^BSDX41G

MRE   ;most recent examination

 G MRE^BSDX41K

MRL   ;most recent lab

 G MRL^BSDX41J

MRPTED ;most recent patient education

 G MRPTED^BSDX41L

MRR   ;most recent radiology

 G MRR^BSDX41K

OFFHX ;offspring history

 G OFFHX^BSDX41E

OUTPT    ;outpatient encounters

 G OUTPT^BSDX41I

PROBA ;allergy problems

 G PROBA^BSDX41C

PTED  ;patient education

 G PTED^BSDX41L

REPHX ;reproductive history

 G REPHX^BSDX41E

SCHENC ;scheduled encounters

 G SCHENC^BSDX41I

SURV   ;surveillance hard code

 G SURV^BSDX41M

TRTMT ;treatments

 G TRTMT^BSDX41E

 ;

 Q

 ;

FILL(PADS,CHAR=" ")

 N I

 S RET=""

 F I=1:1:PADS S RET=RET_CHAR

 Q RET

BSDX41    ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;

 +1       ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010

 +2       ;

 +3       ;return Health Summary output

HS(BSDXY,DFN) ;Health Summary

 +1       ;  DFN  = ien of VA PATIENT (^DPT) file 2

 +2       ;Called by BSDX HEALTH SUMMARY remote procedure

 +3        NEW BSDXI,BSDXSPSG

 +4        DO ^XBKVAR

           SET X="ERROR^BSDXERR"

           SET @^%ZOSF("TRAP")

 +5        SET BSDXI=0

 +6        KILL ^BSDXTMP($JOB)

 +7        SET BSDXY="^BSDXTMP("_$JOB_")"

 +8        SET ^BSDXTMP($JOB,0)="T00080ERRORID"_$CHAR(30)

 +9        IF '+DFN

               DO ERR^BSDXERR("Invalid Patient ID.")

               QUIT 

 +10       IF '$DATA(^DPT(DFN,0))

               DO ERR^BSDXERR("Invalid Patient ID.")

               QUIT 

 +11       SET APCHSPAT=$ORDER(^AUPNPAT("B",DFN,0))

 +12       IF '+APCHSPAT

               DO ERR^BSDXERR("Invalid Patient ID.")

               QUIT 

 +13       IF $DATA(^DISV(DUZ,"APCHSCTL("))

               SET APCHSTYP=^DISV(DUZ,"APCHSCTL(")

 +14       IF $GET(APCHSTYP)=""

               IF +$PIECE($GET(^APCCCTRL(DUZ(2),0)),U,3)

                   SET APCHSTYP=$PIECE(^APCCCTRL(DUZ(2),0),U,3)

 +15       IF $GET(APCHSTYP)=""

               DO ERR^BSDXERR("Health Summary Type not defined in PCC Master Control file.")

               QUIT 

 +16       DO SUPSEGS(.BSDXSPSG)

 +17      ;

 +18       SET ^BSDXTMP($JOB,0)="T10000TEXT"_$CHAR(30)

 +19       SET APCHSCKP="Q:$D(APCHSQIT)  S APCHSNPG=0 I $Y>(IOSL-3) "

 +20       SET APCHSBRK="D BREAK^BSDX41"

 +21       SET APCHSCVD="S:Y]"""" Y=+Y,Y=$E(Y,4,5)_""/""_$S($E(Y,6,7):$E(Y,6,7)_""/"",1:"""")_$E(Y,2,3)"

 +22       IF '$GET(IO)

               SET IO="|TRM|:|"_$JOB

 +23       IF '$GET(IOM)

               SET IOM=80

 +24       IF '$GET(IOSL)

               SET IOSL=24

 +25      ;collect header lines

 +26       SET %=""

           DO NOW^%DTC

           SET X=%

           XECUTE ^DD("FUNC",2,1)

           SET APCHSTIM=X

 +27      ;***** CONFIDENTIAL PATIENT INFORMATION --  DATE/TIME **************

 +28       SET APCHSHDR="CONFIDENTIAL PATIENT INFORMATION -- "_$$FMTE^XLFDT(DT,5)_$JUSTIFY(APCHSTIM,9)_"  ["_$PIECE(^VA(200,DUZ,0),U,2)_"]"

 +29       SET X=""

           SET $PIECE(X,"*",((80-6-$LENGTH(APCHSHDR))\2)+1)="*"

 +30       SET BSDXI=BSDXI+1

           SET ^BSDXTMP($JOB,BSDXI)=X_" "_APCHSHDR_" "_X_$CHAR(30)

 +31      ;pg "_APCHSPG

           SET APCHSHD2=$PIECE(^DPT(APCHSPAT,0),U)_" #"_$$HRN^AUPNPAT(APCHSPAT,DUZ(2))_" "_$$CWAD^AUPNLKID(APCHSPAT)_"("_$PIECE(^APCHSCTL(APCHSTYP,0),U)_" SUMMARY)"

 +32       SET X=""

           SET $PIECE(X,"*",((80-6-$LENGTH(APCHSHD2))\2)+1)="*"

 +33       SET BSDXI=BSDXI+1

           SET ^BSDXTMP($JOB,BSDXI)=X_" "_APCHSHD2_" "_X_$CHAR(30)

           SET BSDXI=BSDXI+1

           SET ^BSDXTMP($JOB,BSDXI)=$CHAR(30)

 +34      ;get segment data

 +35       KILL APCHSQIT

 +36       SET BSDXQIET=1

 +37       SET APCHSEGN=""

           SET APCHSQ=""

 +38       FOR 

               SET APCHSEGN=$ORDER(^APCHSCTL(APCHSTYP,1,"B",APCHSEGN))

               IF APCHSEGN=""

                   QUIT 

               Begin DoDot:1

 +39               SET APCHSEGT=$ORDER(^APCHSCTL(APCHSTYP,1,"B",APCHSEGN,""))

 +40               DO SEGMNT

                   IF $DATA(APCHSQIT)

                       QUIT 

               End DoDot:1

 +41       SET BSDXI=BSDXI+1

           SET ^BSDXTMP($JOB,BSDXI)=$CHAR(31)

 +42       QUIT 

 +43      ;

SEGMNT    ; OUTPUT A SEGMENT TYPE

 +1        SET APCHSN=^APCHSCTL(APCHSTYP,1,APCHSEGT,0)

 +2        SET APCHSEGC=$PIECE(APCHSN,U,2)

           SET APCHSEGH=$PIECE(APCHSN,U,5)

 +3        SET APCHSEGP=^APCHSCMP(APCHSEGC,0)

 +4        SET APCHSEGC=$PIECE(APCHSEGP,U,2)

 +5       ;check if segment converted

           IF '$GET(BSDXSPSG($PIECE(APCHSEGC,";",1),$PIECE(APCHSEGC,";",2)))

               QUIT 

 +6        SET $PIECE(APCHSEGC,";",2)="BSDX41"

 +7        IF APCHSEGH=""

               SET APCHSVAR=$PIECE(APCHSEGP,U,4)

               IF APCHSVAR]""

                   SET APCHSEGH=APCHSVAR

 +8        IF APCHSEGH=""

               SET APCHSEGH=$PIECE(APCHSEGP,U,1)

 +9        SET APCHSVAR=$PIECE(APCHSEGP,U,5)

           IF APCHSVAR]""

               IF $DATA(^XUSEC(APCHSVAR,DUZ))[0

                   QUIT 

 +10      ;S:APCHSNDM>0 APCHSNDM=APCHSNDM+1

           SET APCHSN=^APCHSCTL(APCHSTYP,1,APCHSEGT,0)

           SET APCHSNDM=$PIECE(APCHSN,U,3)

           SET APCHSDLM=$PIECE(APCHSN,U,4)

           IF APCHSNDM=""

               SET APCHSNDM=-1

 +11      ;LIMIT OF TIME OR VISITS

 +12       SET APCHSDLS=""

 +13       IF APCHSDLM?1N.N!(APCHSDLM?1N.N1"D")

               SET APCHSDLS=+APCHSDLM_" day"

 +14       IF APCHSDLM?1N.N1"M"

               SET APCHSDLS=+APCHSDLM_" month"

               SET APCHSDLM=+APCHSDLM*30

 +15       IF APCHSDLM?1N.N1"Y"

               SET APCHSDLS=+APCHSDLM_" year"

               SET APCHSDLM=+APCHSDLM*365

 +16       SET APCHSDLM=+APCHSDLM

 +17       IF +APCHSDLS>1

               SET APCHSDLS=APCHSDLS_"s"

 +18       SET APCHSEGL=""

           IF APCHSNDM>0!(APCHSDLM>0)

               SET APCHSEGL=" (max "_$SELECT(APCHSNDM>0:APCHSNDM_$SELECT(APCHSNDM=1:" visit",1:" visits")_$SELECT(APCHSDLM>0:" or ",1:""),1:"")_$SELECT(APCHSDLM>0:APCHSDLS,1:"")_")"

 +19       KILL APCHSDLS,APCHSN

 +20       IF APCHSDLM'>0

               SET APCHSDLM=9999999

 +21      IF '$TEST

               SET X1=DT

               SET X2=-APCHSDLM

               DO C^%DTC

               SET APCHSDLM=9999999-X

               KILL X1,X2

 +22       DO @($PIECE(APCHSEGC,";",1)_U_$PIECE(APCHSEGC,";",2))

 +23       QUIT 

 +24      ;

HEADER    ;ENTRY POINT

 +1       ;******* KETCHUP,LOIS  (CMED SUMMARY)  pg. 1 ********************

 +2        SET APCHSPG=APCHSPG+1

 +3       ;IHS/ANMC/LJF 4/30/99

           SET APCHSHD2=$PIECE(^DPT(APCHSPAT,0),U)_" #"_$$HRN^AUPNPAT(APCHSPAT,DUZ(2))_" "_$$CWAD^AUPNLKID(APCHSPAT)_"("_$PIECE(^APCHSCTL(APCHSTYP,0),U)_" SUMMARY)  pg "_APCHSPG

 +4        SET APCHSP=""

           SET $PIECE(APCHSP,"*",((IOM-6-$LENGTH(APCHSHD2))\2)+1)="*"

           SET APCHSP=APCHSP_" "_APCHSHD2_" "_APCHSP

 +5        SET BSDXI=BSDXI+1

           SET ^BSDXTMP($JOB,BSDXI)=$CHAR(30)

           SET BSDXI=BSDXI+1

           SET ^BSDXTMP($JOB,BSDXI)=APCHSHDR_$CHAR(30)

           SET BSDXI=BSDXI+1

           SET ^BSDXTMP($JOB,BSDXI)=APCHSP_$CHAR(30)

 +6        QUIT 

 +7       ;

BREAK     ;ENTRY POINT

 +1       ;APCHSEGH IS THE COMPONENT TYPE FROM ^APCHSCMP, FROM SEGMNT ABOVE

 +2       ;------- MEDICATIONS --------------------

 +3        NEW QF

 +4        SET APCHSP=""

           SET $PIECE(APCHSP,"-",+$GET(IOM)-3-$LENGTH(APCHSEGH_APCHSEGL)/2)=""

           SET APCHSP=APCHSP_" "_APCHSEGH_APCHSEGL_" "_APCHSP

 +5        IF $Y'>(IOSL-5)

               Begin DoDot:1

 +6                SET BSDXI=BSDXI+1

                   SET ^BSDXTMP($JOB,BSDXI)=$CHAR(30)

                   SET BSDXI=BSDXI+1

                   SET ^BSDXTMP($JOB,BSDXI)=APCHSP_$CHAR(30)

                   SET BSDXI=BSDXI+1

                   SET ^BSDXTMP($JOB,BSDXI)=$CHAR(30)

 +7                SET QF=1

               End DoDot:1

 +8        IF +$GET(QF)

               QUIT 

 +9        SET BSDXI=BSDXI+1

           SET ^BSDXTMP($JOB,BSDXI)=$CHAR(30)

 +10       XECUTE APCHSCKP

 +11       QUIT 

 +12      ;

SUPSEGS(BSDXSPSG) ;build array of supported segments

 +1        KILL BSDXSPSG

 +2       ; BSDXSPSG(<TAG>,<ORIG ROUTINE>)=1

 +3       ;allergies

           SET BSDXSPSG("ALLRG","APCHGMTS")=1

 +4       ;patient demographics

           SET BSDXSPSG("DEMOG","APCHS1")=1

 +5       ;eye glass prescriptions

           SET BSDXSPSG("EYERX","APCHS8A")=1

 +6       ;flow sheet production

           SET BSDXSPSG("FLOW","APCHS12")=1

 +7       ;health factors

           SET BSDXSPSG("HFACT","APCHS4A")=1

 +8       ;history of surgery

           SET BSDXSPSG("HOS","APCHS6")=1

 +9       ;in hospital encounters

           SET BSDXSPSG("INHOSP","APCHS2B")=1

 +10      ;immunizations

           SET BSDXSPSG("IMMUN","APCHS2")=1

 +11      ;hospitalization encounters

           SET BSDXSPSG("INPT","APCHS2C")=1

 +12      ;insurance

           SET BSDXSPSG("INS","APCHS5")=1

 +13      ;managed care MIS

           SET BSDXSPSG("MCIS","APCHS9")=1

 +14      ;measurement panels

           SET BSDXSPSG("MEASP","APCHS2A")=1

 +15      ;current meds

           SET BSDXSPSG("MEDSCURR","APCHS7")=1

 +16      ;most recent examination

           SET BSDXSPSG("MRE","APCHS3C")=1

 +17      ;most recent lab

           SET BSDXSPSG("MRL","APCHS3A")=1

 +18      ;most recent patient education

           SET BSDXSPSG("MRPTED","APCHS10")=1

 +19      ;most recent radiology

           SET BSDXSPSG("MRR","APCHS3C")=1

 +20      ;outpatient encounters

           SET BSDXSPSG("OUTPT","APCHS2B")=1

 +21      ;allergy problems

           SET BSDXSPSG("PROBA","APCHS40")=1

 +22      ;reproductive history

           SET BSDXSPSG("REPHX","APCHS8")=1

 +23      ;scheduled encounters

           SET BSDXSPSG("SCHENC","APCHS2D")=1

 +24      ;S BSDXSPSG("SURV","APCHS11")=1      ;surveillance hard code   ;not supported yet; appears to use routines in APCHM series;

 +25      ;treatments

           SET BSDXSPSG("TRTMT","APCHS8")=1

 +26      ;these are not in the test scenario and have not been tested

 +27      ;S BSDXSPSG("BIRTHM","APCHS8")=1     ;birth measurements*

 +28      ;S BSDXSPSG("EKG","APCHS8A")=1       ;EKG summary*

 +29      ;S BSDXSPSG("MEAS","APCHS2")=1       ;measurements*

 +30      ;S BSDXSPSG("MEDSALL","APCHS7")=1    ;all meds*

 +31      ;S BSDXSPSG("MEDSCHRN","APCHS7")=1   ;chronic meds*

 +32      ;S BSDXSPSG("MEDSCHR1","APCHS7")=1   ;chronic meds; not DC'd*

 +33      ;S BSDXSPSG("MEDSNDUP","APCHS7")=1   ;all meds, not duplicated*

 +34      ;S BSDXSPSG("OFFHX","APCHS8")=1      ;offspring history*

 +35      ;S BSDXSPSG("PTED","APCHS10")=1      ;patient education

 +36       QUIT 

 +37      ;

ALLRG     ;allergies

 +1        GOTO ALLRG^BSDX41C

BIRTHM    ;birth measurements

 +1        GOTO BIRTHM^BSDX41E

DEMOG     ;patient demographics

 +1        GOTO DEMOG^BSDX41A

EKG       ;EKG summary

 +1        GOTO EKG^BSDX41D

EYERX     ;eye glass perscriptions

 +1        GOTO EYERX^BSDX41D

FLOW      ;flow sheet production

 +1        GOTO FLOW^BSDX41N

HFACT     ;health factors

 +1        GOTO HFACT^BSDX41B

HOS       ;history of surgery

 +1        GOTO HOS^BSDX41F

INHOSP    ;InHospital Encounters

 +1        GOTO INHOSP^BSDX41I

INPT      ;hospitalization encounters

 +1        GOTO INPT^BSDX41I

IMMUN     ;immunizations

 +1        GOTO IMMUN^BSDX41H

INS       ;insurance

 +1        GOTO INS^BSDX41B

MCIS      ;managed care MIS

 +1        GOTO MCIS^BSDX41J

MEAS      ;measurements

 +1        GOTO MEAS^BSDX41H

MEASP     ;measurement panels

 +1        GOTO MEASP^BSDX41D

MEDSALL   ;all meds

 +1        GOTO MEDSALL^BSDX41G

MEDSCHRN  ;chronic meds

 +1        GOTO MEDSCHRN^BSDX41G

MEDSCHR1  ;chronic meds; not DC'd

 +1        GOTO MEDSCHR1^BSDX41G

MEDSCURR  ;current meds

 +1        GOTO MEDSCURR^BSDX41G

MEDSNDUP  ;all meds; non duplicated

 +1        GOTO MEDSNDUP^BSDX41G

MRE       ;most recent examination

 +1        GOTO MRE^BSDX41K

MRL       ;most recent lab

 +1        GOTO MRL^BSDX41J

MRPTED    ;most recent patient education

 +1        GOTO MRPTED^BSDX41L

MRR       ;most recent radiology

 +1        GOTO MRR^BSDX41K

OFFHX     ;offspring history

 +1        GOTO OFFHX^BSDX41E

OUTPT     ;outpatient encounters

 +1        GOTO OUTPT^BSDX41I

PROBA     ;allergy problems

 +1        GOTO PROBA^BSDX41C

PTED      ;patient education

 +1        GOTO PTED^BSDX41L

REPHX     ;reproductive history

 +1        GOTO REPHX^BSDX41E

SCHENC    ;scheduled encounters

 +1        GOTO SCHENC^BSDX41I

SURV      ;surveillance hard code

 +1        GOTO SURV^BSDX41M

TRTMT     ;treatments

 +1        GOTO TRTMT^BSDX41E

 +2       ;

 +3        QUIT 

 +4       ;

FILL(PADS,CHAR=" 

*** ERROR ***