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
;
;******* 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 ;
+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 ***