BMXADOX ; IHS/CIHA/GIS - RPC CALL: GENERATE AN ADO SCHEMA STRING AND DATA SET ;
;;2.0;BMX;;FEB 26, 2007
; EXMAPLES OF RPMS SCHEMAE GENERATION
;
;
DISP(OUT) ;EP - TEMP DISPLAY
N I,X
S I=0 W !
F S I=$O(@OUT@(I)) Q:'I S X=@OUT@(I) S X=$TR(X,$C(30),"}") S X=$TR(X,$C(31),"{") W !,X
Q
;
SCHEMA(NAME) ; GIVEN SCHEMA NAME, RETURN THE IEN
N IEN
S IEN=$O(^BMXADO("B",NAME,0))
Q IEN
;
NEXTNUM(DFN,LOC) ; RETURN THE NEXT PROBLEM NUMBER FOR A PATIENT
N X,LAST,MAX,NUM
S NUM=0,MAX=""
F S NUM=$O(^AUPNPROB("AA",DFN,LOC,NUM)) Q:NUM="" S X=$E(NUM,2,99) I +X>MAX S MAX=+X
I 'MAX Q 1
S X=X+1 S X=X\1
Q X
;
DEMOG ; VIEW DEMOGRAPHICS
N OUT,%,DFN,MAX,SIEN
S DFN=1,MAX=1000
S SIEN=$$SCHEMA("UPDATE PATIENT DEMOGRAPHICS")
D SS^BMXADO(.OUT,SIEN,"",("~"_DFN_"~"_DFN_"~"_MAX))
D DISP(OUT) R %:$G(DTIME,60)
K ^TMP("BMX ADO",$J)
Q
;
MEDICARE ; UPDATE MEDICARE DATES/INFO
N OUT,%,DAS,PIEN,JIEN,DFN,MAX
S DFN=1,MAX=1000
S DAS=DFN_","
S PIEN=$$SCHEMA("UPDATE MEDICARE DATES")
S JIEN=$$SCHEMA("UPDATE MEDICARE INFO")
D SS^BMXADO(.OUT,PIEN,DAS,("~"_DFN_"~"_DFN_"~"_MAX_"~~"_"MEDICARE~BMXADOV2~~"_JIEN_",PARENT"))
D DISP(OUT) R %:$G(DTIME,60)
K ^TMP("BMX ADO",$J)
Q
;
MEDICAID ; VIEW MEDICAID DATES/INFO
N OUT,%,DAS,PIEN,JIEN,DFN,DA
S DFN=3
S DA(1)=$$MCDIEN^BMXADOV2(DFN) I 'DA(1) Q
S DAS=DA(1)_","
S PIEN=$$SCHEMA("UPDATE MEDICAID DATES")
S JIEN=$$SCHEMA("UPDATE MEDICAID INFO")
D SS^BMXADO(.OUT,PIEN,DAS,("~~~~~MEDICAID~BMXADOV2~~"_JIEN_",PARENT"))
D DISP(OUT) R %:$G(DTIME,60)
K ^TMP("BMX ADO",$J)
Q
;
PVTINS ; VIEW PRIVATE INSURANCE DATES/INFO
N OUT,%,DAS,SIEN,DFN
S DFN=1
S DAS=DFN_","
S SIEN=$$SCHEMA("UPDATE PVT INSURANCE INFO")
D SS^BMXADO(.OUT,SIEN,DAS,"~~~~~PVTINS~BMXADOV2~~")
D DISP(OUT) R %:$G(DTIME,60)
K ^TMP("BMX ADO",$J)
Q
;
VISIT ; VIEW VISITS
N OUT,%,SIEN,DFN
S DFN=1
S SIEN=$$SCHEMA("VISITS")
D SS^BMXADO(.OUT,SIEN,"","AA~3/21/1985~6/4/1986~100~~~~1|R")
D DISP(OUT) R %:$G(DTIME,60)
K ^TMP("BMX ADO",$J)
Q
;
DUPVIS ; DISPLAY POSSIBLE DUPLICATE VISITS
N OUT,%,SIEN,DFN
S DFN=1
S SIEN=$$SCHEMA("VISITS")
D SS^BMXADO(.OUT,SIEN,"","~~~~~DUPV~BMXADOV2~1|4/19/04@1PM|I|4585|A~")
D DISP(OUT) R %:$G(DTIME,60)
K ^TMP("BMX ADO",$J)
Q
;
ADDVIS ; ADD A NEW VISIT
N OUT,%,SIEN,DFN,NODE
S DFN=3
S SIEN=$$SCHEMA("VISITS")
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
S ^TMP("BMX ADO",$J,NODE)="^JUN 03, 2004@09:32^I^`3^`4585^A^`1"_$C(30)
D DISP(OUT) R %:$G(DTIME,60)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
K ^TMP("BMX ADO",$J)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
Q
;
POV ; DISPLAY POVS
N OUT,%,SIEN,DFN
S DFN=1
S SIEN=$$SCHEMA("VIEW POVS")
D SS^BMXADO(.OUT,SIEN,"","AA~3/21/1985~6/4/1986~100~~~~1|C")
D DISP(OUT) R %:$G(DTIME,60)
K ^TMP("BMX ADO",$J)
Q
;
FLDS ; GET FILEMAN FIELDS
N OUT,%,SIEN,DFN
S SIEN=$$SCHEMA("FIELDS")
D SS^BMXADO(.OUT,SIEN,"","~~~~~FLDIT~BMXADOS1~3.7~")
D DISP(OUT) R %:$G(DTIME,60)
K ^TMP("BMX ADO",$J)
Q
;
FINFO ; GET FILEMAN FILEINFO
N OUT,%,SIEN,DFN
S SIEN=$$SCHEMA("FILEMAN FILEINFO")
D SS^BMXADO(.OUT,SIEN,"","~~~~~FNIT~BMXADOS1~3.7~")
D DISP(OUT) R %:$G(DTIME,60)
K ^TMP("BMX ADO",$J)
Q
;
ADDPOV ; ADD A POV TO AN EXISITING VISIT
N OUT,%,SIEN,DFN,NODE
S DFN=1
S SIEN=$$SCHEMA("UPDATE POVS")
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
S ^TMP("BMX ADO",$J,NODE)="^`8718^`1^`71164^DM II ON NEW MEDS^2^P"_$C(30)
D DISP(OUT) R %:$G(DTIME,60)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
K ^TMP("BMX ADO",$J)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
Q
;
EDITPOV ; ADD A POV TO AN EXISITING VISIT
N OUT,%,SIEN,DFN,NODE
S DFN=1
S SIEN=$$SCHEMA("UPDATE POVS")
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
S ^TMP("BMX ADO",$J,NODE)="100123^`8718^`1^`71164^DM II ON SPECIAL MEDS^2^P"_$C(30)
D DISP(OUT) R %:$G(DTIME,60)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
K ^TMP("BMX ADO",$J)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
Q
;
PROB ; DISPLAY PROBLEMS
N OUT,%,SIEN,DFN
S DFN=1
S SIEN=$$SCHEMA("VIEW PROBLEMS")
D SS^BMXADO(.OUT,SIEN,"","AA~"_DFN_"~"_DFN_"~~~~~")
D DISP(OUT) R %:$G(DTIME,60)
K ^TMP("BMX ADO",$J)
Q
;
ADDPROB ; ADD A PROBLEM TO THE PROBLEM LIST
N OUT,%,SIEN,DFN,NODE,NUM,LOC,ICD,TEXT,AIR,IEN
S ICD=2477
S TEXT="HYPERTENSION ON SPECIAL MEDS"
S DFN=1,LOC=DUZ(2),AIR="A"
S SIEN=$$SCHEMA("UPDATE PROBLEMS")
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
S ^TMP("BMX ADO",$J,NODE)=U_"`"_ICD_U_"`"_DFN_U_DT_U_U_TEXT_U_"`"_LOC_U_DT_$C(30)
D DISP(OUT) R %:$G(DTIME,60)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
K ^TMP("BMX ADO",$J)
S IEN=+$P(OUT(1),"|",2) I '$D(^AUPNPROB(IEN,0)) Q
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
K OUT
S NUM=$$NEXTNUM(DFN,LOC) I 'NUM Q ; PROBLEM NUMBER & STATUS MUST BE ADDED SEPARATELY
S SIEN=$$SCHEMA("UPDATE PROBLEM NUMBER")
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
S ^TMP("BMX ADO",$J,NODE)=IEN_U_NUM_U_"A"_$C(30)
D DISP(OUT) R %:$G(DTIME,60)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
K ^TMP("BMX ADO",$J)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
Q
;
MEAS ; DISPLAY MEASUREMENTS
N OUT,%,SIEN,DFN
S DFN=1
S SIEN=$$SCHEMA("VIEW MEASUREMENTS")
D SS^BMXADO(.OUT,SIEN,"","AA~3/21/1985~6/4/1986~10~~~~"_DFN_"|WT|C")
D DISP(OUT) R %:$G(DTIME,60)
K ^TMP("BMX ADO",$J)
Q
;
ADDMEAS ; UPDATE V MEASUREMENT FILE
N OUT,%,SIEN,DFN,NODE
S DFN=1
S SIEN=$$SCHEMA("UPDATE MEASUREMENTS")
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
S ^TMP("BMX ADO",$J,NODE)="^`2^`"_DFN_"^`71164^177.5^`6"_$C(30)
D DISP(OUT) R %:$G(DTIME,60)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
K ^TMP("BMX ADO",$J)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
Q
;
MEDS ; DISPLAY MEDS
N OUT,%,SIEN,DFN
S DFN=3
S SIEN=$$SCHEMA("VIEW MEDS")
D SS^BMXADO(.OUT,SIEN,"","AA~1/1/1989~12/31/1990~10~~~~"_DFN_"|C")
D DISP(OUT) R %:$G(DTIME,60)
K ^TMP("BMX ADO",$J)
Q
;
ADDMEDS ; UPDATE V MED FILE
N OUT,%,SIEN,DFN,NODE
S DFN=3
S SIEN=$$SCHEMA("UPDATE MEDS")
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
S ^TMP("BMX ADO",$J,NODE)="^`305^`"_DFN_"^`71164^T1T QID^40"_$C(30)
D DISP(OUT) R %:$G(DTIME,60)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
K ^TMP("BMX ADO",$J)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
Q
;
LAB ; DISPLAY LAB TEST RESULTS
N OUT,%,SIEN,DFN
S DFN=1
S SIEN=$$SCHEMA("VIEW LABS")
D SS^BMXADO(.OUT,SIEN,"","AA~1/1/1985~12/31/1987~10~~~~"_DFN_"|175|C")
D DISP(OUT) R %:$G(DTIME,60)
K ^TMP("BMX ADO",$J)
Q
;
ADDLAB ; UPDATE V LAB
N OUT,%,SIEN,DFN,NODE
S DFN=1
S SIEN=$$SCHEMA("UPDATE LABS")
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
S ^TMP("BMX ADO",$J,NODE)="^`175^`"_DFN_"^`71164^216"_$C(30)
D DISP(OUT) R %:$G(DTIME,60)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
K ^TMP("BMX ADO",$J)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
Q
;
EXAMS ; DISPLAY EXAMS
N OUT,%,SIEN,DFN
S DFN=1
S SIEN=$$SCHEMA("VIEW EXAMS")
D SS^BMXADO(.OUT,SIEN,"","AA~1/1/1986~12/31/1990~10~~~~"_DFN_"|6|C")
D DISP(OUT) R %:$G(DTIME,60)
K ^TMP("BMX ADO",$J)
Q
;
ADDEXAMS ; UPDATE V EXAM
S DFN=1
S SIEN=$$SCHEMA("UPDATE EXAMS")
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
S ^TMP("BMX ADO",$J,NODE)="^`6^`"_DFN_"^`71164^NORMAL"_$C(30)
D DISP(OUT) R %:$G(DTIME,60)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
K ^TMP("BMX ADO",$J)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
Q
;
IMM ; DISPLAY IMMUNIZATIONS
N OUT,%,SIEN,DFN
S DFN=2
S SIEN=$$SCHEMA("VIEW IMM")
D SS^BMXADO(.OUT,SIEN,"","AA~1/1/1986~12/31/1988~10~~~~"_DFN_"|12|C")
D DISP(OUT) R %:$G(DTIME,60)
K ^TMP("BMX ADO",$J)
Q
;
ADDIMM ; UPDATE V IMMUNIZATION FILE
S DFN=2
S SIEN=$$SCHEMA("UPDATE IMM")
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
S ^TMP("BMX ADO",$J,NODE)="^`12^`"_DFN_"^`71164^2"_$C(30)
D DISP(OUT) R %:$G(DTIME,60)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
K ^TMP("BMX ADO",$J)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
Q
;
PROV ; DISPLAY PROVIDERS FOR A VISIT
N OUT,%,SIEN,VIEN
S VIEN=11
S SIEN=$$SCHEMA("VIEW PROV")
D SS^BMXADO(.OUT,SIEN,"","AD~"_VIEN_"~"_VIEN_"~10~~~~")
D DISP(OUT) R %:$G(DTIME,60)
K ^TMP("BMX ADO",$J)
Q
;
ADDPROV ; UPDATE V PROVIDER FILE
N OUT,%,SIEN,NODE,PIEN,DFN
S PIEN=5,DFN=1
I $P(^DD(9000010.06,.01,0),U,3)["DIC(6" S PIEN=$P(^VA(200,PIEN,0),U,16) ; CONVERT FILE 200 TO FILE 16 IF NECESS.
S SIEN=$$SCHEMA("UPDATE PROV")
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
S ^TMP("BMX ADO",$J,NODE)="^`"_PIEN_"^`"_DFN_"^`71164^P"_$C(30)
D DISP(OUT) R %:$G(DTIME,60)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
K ^TMP("BMX ADO",$J)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
Q
;
PROC ; DISPLAY PROCEDURES
N OUT,%,SIEN,DFN
S DFN=4
S SIEN=$$SCHEMA("VIEW PROCEDURES")
D SS^BMXADO(.OUT,SIEN,"","AA~1/1/1985~12/31/1985~10~~~~"_DFN_"|C")
D DISP(OUT) R %:$G(DTIME,60)
K ^TMP("BMX ADO",$J)
Q
;
ADDPROC ; UPDATE V PROCEDURES FILE
N OUT,%,SIEN,DFN,NODE
S DFN=1
S SIEN=$$SCHEMA("UPDATE PROCEDURES")
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
S ^TMP("BMX ADO",$J,NODE)="^`2198^`"_DFN_"^`71164^`8718"_$C(30)
D DISP(OUT) R %:$G(DTIME,60)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
K ^TMP("BMX ADO",$J)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
Q
;
CPT ; DISPLAY CPT CODES
N OUT,%,SIEN,DFN
S VIEN=71164
S SIEN=$$SCHEMA("VIEW CPT")
D SS^BMXADO(.OUT,SIEN,"","AD~"_VIEN_"~"_VIEN_"~10~~~~")
D DISP(OUT) R %:$G(DTIME,60)
K ^TMP("BMX ADO",$J)
Q
;
ADDCPT ; UPDATE V CPT FILE
N OUT,%,SIEN,DFN,NODE
S DFN=1
S SIEN=$$SCHEMA("UPDATE CPT")
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
S ^TMP("BMX ADO",$J,NODE)="^`10000^`"_DFN_"^`71164^WOUND CARE"_$C(30)
D DISP(OUT) R %:$G(DTIME,60)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
K ^TMP("BMX ADO",$J)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
Q
;
PH ; DISPLAY PERSONAL HISTORY
N OUT,%,SIEN,DFN
S DFN=632
S SIEN=$$SCHEMA("VIEW PERSONAL HISTORY")
D SS^BMXADO(.OUT,SIEN,"","AC~"_DFN_"~"_DFN_"~~~~~")
D DISP(OUT) R %:$G(DTIME,60)
K ^TMP("BMX ADO",$J)
Q
;
ADDPH ; UPDATE PERSONAL HX
N OUT,%,SIEN,DFN,NODE,ICD,TEXT
S ICD=2477
S TEXT="PERSONAL HISTORY OF SERIOUS PROBLEMS"
S DFN=632
S SIEN=$$SCHEMA("UPDATE PERSONAL HISTORY")
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
S ^TMP("BMX ADO",$J,NODE)="^`11353^`"_DFN_"^2851219^"_TEXT_"^2810303"_$C(30)
D DISP(OUT) R %:$G(DTIME,60)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
K ^TMP("BMX ADO",$J)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
Q
;
FH ; DISPLAY FAMILY HX
N OUT,%,SIEN,DFN
S DFN=631
S SIEN=$$SCHEMA("VIEW FAMILY HISTORY")
D SS^BMXADO(.OUT,SIEN,"","AC~"_DFN_"~"_DFN_"~~~~~")
D DISP(OUT) R %:$G(DTIME,60)
K ^TMP("BMX ADO",$J)
Q
;
ADDFH ; UPDATE FAMILY HISTORY
N OUT,%,SIEN,DFN,NODE,ICD,TEXT
S ICD=2477
S TEXT="FAMILY HISTORY OF SERIOUS PROBLEMS"
S DFN=631
S SIEN=$$SCHEMA("UPDATE FAMILY HISTORY")
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
S ^TMP("BMX ADO",$J,NODE)="^`7571^`"_DFN_"^2851219^"_TEXT_$C(30)
D DISP(OUT) R %:$G(DTIME,60)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
K ^TMP("BMX ADO",$J)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
Q
;
HF ; DISPLAY HEALTH FACTORS
N OUT,%,SIEN,DFN
S DFN=1
S SIEN=$$SCHEMA("VIEW HEALTH FACTORS")
D SS^BMXADO(.OUT,SIEN,"","AC"_"~"_DFN_"~"_DFN_"~~~~~")
D DISP(OUT) R %:$G(DTIME,60)
K ^TMP("BMX ADO",$J)
Q
;
ADDHF ; UPDATE HEALTH FACTORS FILE
N OUT,%,SIEN,DFN,NODE
S DFN=1
S SIEN=$$SCHEMA("UPDATE HEALTH FACTORS")
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
S ^TMP("BMX ADO",$J,NODE)="^`3^`"_DFN_U_DT_$C(30)
D DISP(OUT) R %:$G(DTIME,60)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
K ^TMP("BMX ADO",$J)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
Q
;
REPRO ; DISPLAY REPRODUCTIVE FACTORS
N OUT,%,SIEN,DFN
S DFN=5
S SIEN=$$SCHEMA("VIEW REPRODUCTIVE FACTORS")
D SS^BMXADO(.OUT,SIEN,"","B"_"~"_DFN_"~"_DFN_"~~~~~")
D DISP(OUT) R %:$G(DTIME,60)
K ^TMP("BMX ADO",$J)
Q
;
ADDREPRO ; UPDATE REPRODUCTIVE FACTORS
; THE .O1 FIELD IS DINUMED
; THEREFORE, THE FILER WILL AUTOMATICALLY SWITCH TO MOD MODE IF A RECORD ALREADY EXISTS FOR THIS PATIENT
N OUT,%,SIEN,DFN,NODE
S DFN=5
; I $D(^AUPNREP(DFN)) G ERF
S SIEN=$$SCHEMA("ADD REPRODUCTIVE FACTORS")
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
S ^TMP("BMX ADO",$J,NODE)="^`"_DFN_"^G5P4LC3SA1TA0^"_DT_"^2^3040101^"_DT_$C(30)
D DISP(OUT) R %:$G(DTIME,60)
D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
K ^TMP("BMX ADO",$J)
W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
Q
;
; ---------------------------------- GRIDS ---------------------------------------------
;
GRID ; POPULATE THE INTRO GRID
N OUT,%,SIEN,NODE,NEXT
S NEXT="70470;0"
S SIEN=$$SCHEMA("VEN MOJO DE INTRO")
D SS^BMXADO(.OUT,SIEN,"","ASEG~"_NEXT_"~"_NEXT) ; GET SCHEMA
D DISP(OUT) R %:$G(DTIME,60)
K ^TMP("BMX ADO",$J)
Q
;
MGRID ; POPULATE THE MEASUREMENT GRID
N OUT,%,SIEN,NODE,NEXT,START,STOP
S NEXT="70470;2"
S SIEN=$$SCHEMA("VEN MOJO DE MEASUREMENT")
; D SS^BMXADO(.OUT,SIEN,"","~~~~~GRIDIT~VENPCCTG~"_NEXT) ; GET SCHEMA
D SS^BMXADO(.OUT,SIEN,"","ASEG~"_NEXT_"~"_NEXT) ; GET SCHEMA
D DISP(OUT) R %:$G(DTIME,60)
; K ^TMP("BMX ADO",$J)
Q
;
PRVGRID ; POPULATE THE PROVIDER GRID
N OUT,%,SIEN,NODE,NEXT
S NEXT="70470;4"
S SIEN=$$SCHEMA("VEN MOJO DE PROVIDER")
D SS^BMXADO(.OUT,SIEN,"","ASEG~"_NEXT_"~"_NEXT) ; GET SCHEMA
D DISP(OUT) R %:$G(DTIME,60)
K ^TMP("BMX ADO",$J)
Q
;
CLGRID ; POPULATE THE CLINIC GRID
N OUT,%,SIEN,NODE,NEXT
S NEXT="70470;8"
S SIEN=$$SCHEMA("VEN MOJO DE CLINIC")
D SS^BMXADO(.OUT,SIEN,"","ASEG~"_NEXT_"~"_NEXT) ; GET SCHEMA
D DISP(OUT) R %:$G(DTIME,60)
K ^TMP("BMX ADO",$J)
Q
;
DXGRID ; POPULATE THE DX GRID
N OUT,%,SIEN,NODE,NEXT
S NEXT="70470;1"
S SIEN=$$SCHEMA("VEN MOJO DE DX DXHX")
D SS^BMXADO(.OUT,SIEN,"","ASEG~"_NEXT_"~"_NEXT) ; GET SCHEMA
D DISP(OUT) R %:$G(DTIME,60)
K ^TMP("BMX ADO",$J)
Q
;
BMXADOX ; IHS/CIHA/GIS - RPC CALL: GENERATE AN ADO SCHEMA STRING AND DATA SET ;
+1 ;;2.0;BMX;;FEB 26, 2007
+2 ; EXMAPLES OF RPMS SCHEMAE GENERATION
+3 ;
+4 ;
DISP(OUT) ;EP - TEMP DISPLAY
+1 NEW I,X
+2 SET I=0
WRITE !
+3 FOR
SET I=$ORDER(@OUT@(I))
IF 'I
QUIT
SET X=@OUT@(I)
SET X=$TRANSLATE(X,$CHAR(30),"}")
SET X=$TRANSLATE(X,$CHAR(31),"{")
WRITE !,X
+4 QUIT
+5 ;
SCHEMA(NAME) ; GIVEN SCHEMA NAME, RETURN THE IEN
+1 NEW IEN
+2 SET IEN=$ORDER(^BMXADO("B",NAME,0))
+3 QUIT IEN
+4 ;
NEXTNUM(DFN,LOC) ; RETURN THE NEXT PROBLEM NUMBER FOR A PATIENT
+1 NEW X,LAST,MAX,NUM
+2 SET NUM=0
SET MAX=""
+3 FOR
SET NUM=$ORDER(^AUPNPROB("AA",DFN,LOC,NUM))
IF NUM=""
QUIT
SET X=$EXTRACT(NUM,2,99)
IF +X>MAX
SET MAX=+X
+4 IF 'MAX
QUIT 1
+5 SET X=X+1
SET X=X\1
+6 QUIT X
+7 ;
DEMOG ; VIEW DEMOGRAPHICS
+1 NEW OUT,%,DFN,MAX,SIEN
+2 SET DFN=1
SET MAX=1000
+3 SET SIEN=$$SCHEMA("UPDATE PATIENT DEMOGRAPHICS")
+4 DO SS^BMXADO(.OUT,SIEN,"",("~"_DFN_"~"_DFN_"~"_MAX))
+5 DO DISP(OUT)
READ %:$GET(DTIME,60)
+6 KILL ^TMP("BMX ADO",$JOB)
+7 QUIT
+8 ;
MEDICARE ; UPDATE MEDICARE DATES/INFO
+1 NEW OUT,%,DAS,PIEN,JIEN,DFN,MAX
+2 SET DFN=1
SET MAX=1000
+3 SET DAS=DFN_","
+4 SET PIEN=$$SCHEMA("UPDATE MEDICARE DATES")
+5 SET JIEN=$$SCHEMA("UPDATE MEDICARE INFO")
+6 DO SS^BMXADO(.OUT,PIEN,DAS,("~"_DFN_"~"_DFN_"~"_MAX_"~~"_"MEDICARE~BMXADOV2~~"_JIEN_",PARENT"))
+7 DO DISP(OUT)
READ %:$GET(DTIME,60)
+8 KILL ^TMP("BMX ADO",$JOB)
+9 QUIT
+10 ;
MEDICAID ; VIEW MEDICAID DATES/INFO
+1 NEW OUT,%,DAS,PIEN,JIEN,DFN,DA
+2 SET DFN=3
+3 SET DA(1)=$$MCDIEN^BMXADOV2(DFN)
IF 'DA(1)
QUIT
+4 SET DAS=DA(1)_","
+5 SET PIEN=$$SCHEMA("UPDATE MEDICAID DATES")
+6 SET JIEN=$$SCHEMA("UPDATE MEDICAID INFO")
+7 DO SS^BMXADO(.OUT,PIEN,DAS,("~~~~~MEDICAID~BMXADOV2~~"_JIEN_",PARENT"))
+8 DO DISP(OUT)
READ %:$GET(DTIME,60)
+9 KILL ^TMP("BMX ADO",$JOB)
+10 QUIT
+11 ;
PVTINS ; VIEW PRIVATE INSURANCE DATES/INFO
+1 NEW OUT,%,DAS,SIEN,DFN
+2 SET DFN=1
+3 SET DAS=DFN_","
+4 SET SIEN=$$SCHEMA("UPDATE PVT INSURANCE INFO")
+5 DO SS^BMXADO(.OUT,SIEN,DAS,"~~~~~PVTINS~BMXADOV2~~")
+6 DO DISP(OUT)
READ %:$GET(DTIME,60)
+7 KILL ^TMP("BMX ADO",$JOB)
+8 QUIT
+9 ;
VISIT ; VIEW VISITS
+1 NEW OUT,%,SIEN,DFN
+2 SET DFN=1
+3 SET SIEN=$$SCHEMA("VISITS")
+4 DO SS^BMXADO(.OUT,SIEN,"","AA~3/21/1985~6/4/1986~100~~~~1|R")
+5 DO DISP(OUT)
READ %:$GET(DTIME,60)
+6 KILL ^TMP("BMX ADO",$JOB)
+7 QUIT
+8 ;
DUPVIS ; DISPLAY POSSIBLE DUPLICATE VISITS
+1 NEW OUT,%,SIEN,DFN
+2 SET DFN=1
+3 SET SIEN=$$SCHEMA("VISITS")
+4 DO SS^BMXADO(.OUT,SIEN,"","~~~~~DUPV~BMXADOV2~1|4/19/04@1PM|I|4585|A~")
+5 DO DISP(OUT)
READ %:$GET(DTIME,60)
+6 KILL ^TMP("BMX ADO",$JOB)
+7 QUIT
+8 ;
ADDVIS ; ADD A NEW VISIT
+1 NEW OUT,%,SIEN,DFN,NODE
+2 SET DFN=3
+3 SET SIEN=$$SCHEMA("VISITS")
+4 ; GET SCHEMA
DO SS^BMXADO(.OUT,SIEN,"","")
+5 SET NODE=$ORDER(^TMP("BMX ADO",$JOB,999999),-1)+1
+6 SET ^TMP("BMX ADO",$JOB,NODE)="^JUN 03, 2004@09:32^I^`3^`4585^A^`1"_$CHAR(30)
+7 DO DISP(OUT)
READ %:$GET(DTIME,60)
+8 DO BAFM^BMXADOF1(.OUT,$NAME(^TMP("BMX ADO",$JOB)))
+9 KILL ^TMP("BMX ADO",$JOB)
+10 WRITE !!,OUT
SET %=0
FOR
SET %=$ORDER(OUT(%))
IF '%
QUIT
WRITE !,OUT(%)
+11 QUIT
+12 ;
POV ; DISPLAY POVS
+1 NEW OUT,%,SIEN,DFN
+2 SET DFN=1
+3 SET SIEN=$$SCHEMA("VIEW POVS")
+4 DO SS^BMXADO(.OUT,SIEN,"","AA~3/21/1985~6/4/1986~100~~~~1|C")
+5 DO DISP(OUT)
READ %:$GET(DTIME,60)
+6 KILL ^TMP("BMX ADO",$JOB)
+7 QUIT
+8 ;
FLDS ; GET FILEMAN FIELDS
+1 NEW OUT,%,SIEN,DFN
+2 SET SIEN=$$SCHEMA("FIELDS")
+3 DO SS^BMXADO(.OUT,SIEN,"","~~~~~FLDIT~BMXADOS1~3.7~")
+4 DO DISP(OUT)
READ %:$GET(DTIME,60)
+5 KILL ^TMP("BMX ADO",$JOB)
+6 QUIT
+7 ;
FINFO ; GET FILEMAN FILEINFO
+1 NEW OUT,%,SIEN,DFN
+2 SET SIEN=$$SCHEMA("FILEMAN FILEINFO")
+3 DO SS^BMXADO(.OUT,SIEN,"","~~~~~FNIT~BMXADOS1~3.7~")
+4 DO DISP(OUT)
READ %:$GET(DTIME,60)
+5 KILL ^TMP("BMX ADO",$JOB)
+6 QUIT
+7 ;
ADDPOV ; ADD A POV TO AN EXISITING VISIT
+1 NEW OUT,%,SIEN,DFN,NODE
+2 SET DFN=1
+3 SET SIEN=$$SCHEMA("UPDATE POVS")
+4 ; GET SCHEMA
DO SS^BMXADO(.OUT,SIEN,"","")
+5 SET NODE=$ORDER(^TMP("BMX ADO",$JOB,999999),-1)+1
+6 SET ^TMP("BMX ADO",$JOB,NODE)="^`8718^`1^`71164^DM II ON NEW MEDS^2^P"_$CHAR(30)
+7 DO DISP(OUT)
READ %:$GET(DTIME,60)
+8 DO BAFM^BMXADOF1(.OUT,$NAME(^TMP("BMX ADO",$JOB)))
+9 KILL ^TMP("BMX ADO",$JOB)
+10 WRITE !!,OUT
SET %=0
FOR
SET %=$ORDER(OUT(%))
IF '%
QUIT
WRITE !,OUT(%)
+11 QUIT
+12 ;
EDITPOV ; ADD A POV TO AN EXISITING VISIT
+1 NEW OUT,%,SIEN,DFN,NODE
+2 SET DFN=1
+3 SET SIEN=$$SCHEMA("UPDATE POVS")
+4 ; GET SCHEMA
DO SS^BMXADO(.OUT,SIEN,"","")
+5 SET NODE=$ORDER(^TMP("BMX ADO",$JOB,999999),-1)+1
+6 SET ^TMP("BMX ADO",$JOB,NODE)="100123^`8718^`1^`71164^DM II ON SPECIAL MEDS^2^P"_$CHAR(30)
+7 DO DISP(OUT)
READ %:$GET(DTIME,60)
+8 DO BAFM^BMXADOF1(.OUT,$NAME(^TMP("BMX ADO",$JOB)))
+9 KILL ^TMP("BMX ADO",$JOB)
+10 WRITE !!,OUT
SET %=0
FOR
SET %=$ORDER(OUT(%))
IF '%
QUIT
WRITE !,OUT(%)
+11 QUIT
+12 ;
PROB ; DISPLAY PROBLEMS
+1 NEW OUT,%,SIEN,DFN
+2 SET DFN=1
+3 SET SIEN=$$SCHEMA("VIEW PROBLEMS")
+4 DO SS^BMXADO(.OUT,SIEN,"","AA~"_DFN_"~"_DFN_"~~~~~")
+5 DO DISP(OUT)
READ %:$GET(DTIME,60)
+6 KILL ^TMP("BMX ADO",$JOB)
+7 QUIT
+8 ;
ADDPROB ; ADD A PROBLEM TO THE PROBLEM LIST
+1 NEW OUT,%,SIEN,DFN,NODE,NUM,LOC,ICD,TEXT,AIR,IEN
+2 SET ICD=2477
+3 SET TEXT="HYPERTENSION ON SPECIAL MEDS"
+4 SET DFN=1
SET LOC=DUZ(2)
SET AIR="A"
+5 SET SIEN=$$SCHEMA("UPDATE PROBLEMS")
+6 ; GET SCHEMA
DO SS^BMXADO(.OUT,SIEN,"","")
+7 SET NODE=$ORDER(^TMP("BMX ADO",$JOB,999999),-1)+1
+8 SET ^TMP("BMX ADO",$JOB,NODE)=U_"`"_ICD_U_"`"_DFN_U_DT_U_U_TEXT_U_"`"_LOC_U_DT_$CHAR(30)
+9 DO DISP(OUT)
READ %:$GET(DTIME,60)
+10 DO BAFM^BMXADOF1(.OUT,$NAME(^TMP("BMX ADO",$JOB)))
+11 KILL ^TMP("BMX ADO",$JOB)
+12 SET IEN=+$PIECE(OUT(1),"|",2)
IF '$DATA(^AUPNPROB(IEN,0))
QUIT
+13 WRITE !!,OUT
SET %=0
FOR
SET %=$ORDER(OUT(%))
IF '%
QUIT
WRITE !,OUT(%)
+14 KILL OUT
+15 ; PROBLEM NUMBER & STATUS MUST BE ADDED SEPARATELY
SET NUM=$$NEXTNUM(DFN,LOC)
IF 'NUM
QUIT
+16 SET SIEN=$$SCHEMA("UPDATE PROBLEM NUMBER")
+17 ; GET SCHEMA
DO SS^BMXADO(.OUT,SIEN,"","")
+18 SET NODE=$ORDER(^TMP("BMX ADO",$JOB,999999),-1)+1
+19 SET ^TMP("BMX ADO",$JOB,NODE)=IEN_U_NUM_U_"A"_$CHAR(30)
+20 DO DISP(OUT)
READ %:$GET(DTIME,60)
+21 DO BAFM^BMXADOF1(.OUT,$NAME(^TMP("BMX ADO",$JOB)))
+22 KILL ^TMP("BMX ADO",$JOB)
+23 WRITE !!,OUT
SET %=0
FOR
SET %=$ORDER(OUT(%))
IF '%
QUIT
WRITE !,OUT(%)
+24 QUIT
+25 ;
MEAS ; DISPLAY MEASUREMENTS
+1 NEW OUT,%,SIEN,DFN
+2 SET DFN=1
+3 SET SIEN=$$SCHEMA("VIEW MEASUREMENTS")
+4 DO SS^BMXADO(.OUT,SIEN,"","AA~3/21/1985~6/4/1986~10~~~~"_DFN_"|WT|C")
+5 DO DISP(OUT)
READ %:$GET(DTIME,60)
+6 KILL ^TMP("BMX ADO",$JOB)
+7 QUIT
+8 ;
ADDMEAS ; UPDATE V MEASUREMENT FILE
+1 NEW OUT,%,SIEN,DFN,NODE
+2 SET DFN=1
+3 SET SIEN=$$SCHEMA("UPDATE MEASUREMENTS")
+4 ; GET SCHEMA
DO SS^BMXADO(.OUT,SIEN,"","")
+5 SET NODE=$ORDER(^TMP("BMX ADO",$JOB,999999),-1)+1
+6 SET ^TMP("BMX ADO",$JOB,NODE)="^`2^`"_DFN_"^`71164^177.5^`6"_$CHAR(30)
+7 DO DISP(OUT)
READ %:$GET(DTIME,60)
+8 DO BAFM^BMXADOF1(.OUT,$NAME(^TMP("BMX ADO",$JOB)))
+9 KILL ^TMP("BMX ADO",$JOB)
+10 WRITE !!,OUT
SET %=0
FOR
SET %=$ORDER(OUT(%))
IF '%
QUIT
WRITE !,OUT(%)
+11 QUIT
+12 ;
MEDS ; DISPLAY MEDS
+1 NEW OUT,%,SIEN,DFN
+2 SET DFN=3
+3 SET SIEN=$$SCHEMA("VIEW MEDS")
+4 DO SS^BMXADO(.OUT,SIEN,"","AA~1/1/1989~12/31/1990~10~~~~"_DFN_"|C")
+5 DO DISP(OUT)
READ %:$GET(DTIME,60)
+6 KILL ^TMP("BMX ADO",$JOB)
+7 QUIT
+8 ;
ADDMEDS ; UPDATE V MED FILE
+1 NEW OUT,%,SIEN,DFN,NODE
+2 SET DFN=3
+3 SET SIEN=$$SCHEMA("UPDATE MEDS")
+4 ; GET SCHEMA
DO SS^BMXADO(.OUT,SIEN,"","")
+5 SET NODE=$ORDER(^TMP("BMX ADO",$JOB,999999),-1)+1
+6 SET ^TMP("BMX ADO",$JOB,NODE)="^`305^`"_DFN_"^`71164^T1T QID^40"_$CHAR(30)
+7 DO DISP(OUT)
READ %:$GET(DTIME,60)
+8 DO BAFM^BMXADOF1(.OUT,$NAME(^TMP("BMX ADO",$JOB)))
+9 KILL ^TMP("BMX ADO",$JOB)
+10 WRITE !!,OUT
SET %=0
FOR
SET %=$ORDER(OUT(%))
IF '%
QUIT
WRITE !,OUT(%)
+11 QUIT
+12 ;
LAB ; DISPLAY LAB TEST RESULTS
+1 NEW OUT,%,SIEN,DFN
+2 SET DFN=1
+3 SET SIEN=$$SCHEMA("VIEW LABS")
+4 DO SS^BMXADO(.OUT,SIEN,"","AA~1/1/1985~12/31/1987~10~~~~"_DFN_"|175|C")
+5 DO DISP(OUT)
READ %:$GET(DTIME,60)
+6 KILL ^TMP("BMX ADO",$JOB)
+7 QUIT
+8 ;
ADDLAB ; UPDATE V LAB
+1 NEW OUT,%,SIEN,DFN,NODE
+2 SET DFN=1
+3 SET SIEN=$$SCHEMA("UPDATE LABS")
+4 ; GET SCHEMA
DO SS^BMXADO(.OUT,SIEN,"","")
+5 SET NODE=$ORDER(^TMP("BMX ADO",$JOB,999999),-1)+1
+6 SET ^TMP("BMX ADO",$JOB,NODE)="^`175^`"_DFN_"^`71164^216"_$CHAR(30)
+7 DO DISP(OUT)
READ %:$GET(DTIME,60)
+8 DO BAFM^BMXADOF1(.OUT,$NAME(^TMP("BMX ADO",$JOB)))
+9 KILL ^TMP("BMX ADO",$JOB)
+10 WRITE !!,OUT
SET %=0
FOR
SET %=$ORDER(OUT(%))
IF '%
QUIT
WRITE !,OUT(%)
+11 QUIT
+12 ;
EXAMS ; DISPLAY EXAMS
+1 NEW OUT,%,SIEN,DFN
+2 SET DFN=1
+3 SET SIEN=$$SCHEMA("VIEW EXAMS")
+4 DO SS^BMXADO(.OUT,SIEN,"","AA~1/1/1986~12/31/1990~10~~~~"_DFN_"|6|C")
+5 DO DISP(OUT)
READ %:$GET(DTIME,60)
+6 KILL ^TMP("BMX ADO",$JOB)
+7 QUIT
+8 ;
ADDEXAMS ; UPDATE V EXAM
+1 SET DFN=1
+2 SET SIEN=$$SCHEMA("UPDATE EXAMS")
+3 ; GET SCHEMA
DO SS^BMXADO(.OUT,SIEN,"","")
+4 SET NODE=$ORDER(^TMP("BMX ADO",$JOB,999999),-1)+1
+5 SET ^TMP("BMX ADO",$JOB,NODE)="^`6^`"_DFN_"^`71164^NORMAL"_$CHAR(30)
+6 DO DISP(OUT)
READ %:$GET(DTIME,60)
+7 DO BAFM^BMXADOF1(.OUT,$NAME(^TMP("BMX ADO",$JOB)))
+8 KILL ^TMP("BMX ADO",$JOB)
+9 WRITE !!,OUT
SET %=0
FOR
SET %=$ORDER(OUT(%))
IF '%
QUIT
WRITE !,OUT(%)
+10 QUIT
+11 ;
IMM ; DISPLAY IMMUNIZATIONS
+1 NEW OUT,%,SIEN,DFN
+2 SET DFN=2
+3 SET SIEN=$$SCHEMA("VIEW IMM")
+4 DO SS^BMXADO(.OUT,SIEN,"","AA~1/1/1986~12/31/1988~10~~~~"_DFN_"|12|C")
+5 DO DISP(OUT)
READ %:$GET(DTIME,60)
+6 KILL ^TMP("BMX ADO",$JOB)
+7 QUIT
+8 ;
ADDIMM ; UPDATE V IMMUNIZATION FILE
+1 SET DFN=2
+2 SET SIEN=$$SCHEMA("UPDATE IMM")
+3 ; GET SCHEMA
DO SS^BMXADO(.OUT,SIEN,"","")
+4 SET NODE=$ORDER(^TMP("BMX ADO",$JOB,999999),-1)+1
+5 SET ^TMP("BMX ADO",$JOB,NODE)="^`12^`"_DFN_"^`71164^2"_$CHAR(30)
+6 DO DISP(OUT)
READ %:$GET(DTIME,60)
+7 DO BAFM^BMXADOF1(.OUT,$NAME(^TMP("BMX ADO",$JOB)))
+8 KILL ^TMP("BMX ADO",$JOB)
+9 WRITE !!,OUT
SET %=0
FOR
SET %=$ORDER(OUT(%))
IF '%
QUIT
WRITE !,OUT(%)
+10 QUIT
+11 ;
PROV ; DISPLAY PROVIDERS FOR A VISIT
+1 NEW OUT,%,SIEN,VIEN
+2 SET VIEN=11
+3 SET SIEN=$$SCHEMA("VIEW PROV")
+4 DO SS^BMXADO(.OUT,SIEN,"","AD~"_VIEN_"~"_VIEN_"~10~~~~")
+5 DO DISP(OUT)
READ %:$GET(DTIME,60)
+6 KILL ^TMP("BMX ADO",$JOB)
+7 QUIT
+8 ;
ADDPROV ; UPDATE V PROVIDER FILE
+1 NEW OUT,%,SIEN,NODE,PIEN,DFN
+2 SET PIEN=5
SET DFN=1
+3 ; CONVERT FILE 200 TO FILE 16 IF NECESS.
IF $PIECE(^DD(9000010.06,.01,0),U,3)["DIC(6"
SET PIEN=$PIECE(^VA(200,PIEN,0),U,16)
+4 SET SIEN=$$SCHEMA("UPDATE PROV")
+5 ; GET SCHEMA
DO SS^BMXADO(.OUT,SIEN,"","")
+6 SET NODE=$ORDER(^TMP("BMX ADO",$JOB,999999),-1)+1
+7 SET ^TMP("BMX ADO",$JOB,NODE)="^`"_PIEN_"^`"_DFN_"^`71164^P"_$CHAR(30)
+8 DO DISP(OUT)
READ %:$GET(DTIME,60)
+9 DO BAFM^BMXADOF1(.OUT,$NAME(^TMP("BMX ADO",$JOB)))
+10 KILL ^TMP("BMX ADO",$JOB)
+11 WRITE !!,OUT
SET %=0
FOR
SET %=$ORDER(OUT(%))
IF '%
QUIT
WRITE !,OUT(%)
+12 QUIT
+13 ;
PROC ; DISPLAY PROCEDURES
+1 NEW OUT,%,SIEN,DFN
+2 SET DFN=4
+3 SET SIEN=$$SCHEMA("VIEW PROCEDURES")
+4 DO SS^BMXADO(.OUT,SIEN,"","AA~1/1/1985~12/31/1985~10~~~~"_DFN_"|C")
+5 DO DISP(OUT)
READ %:$GET(DTIME,60)
+6 KILL ^TMP("BMX ADO",$JOB)
+7 QUIT
+8 ;
ADDPROC ; UPDATE V PROCEDURES FILE
+1 NEW OUT,%,SIEN,DFN,NODE
+2 SET DFN=1
+3 SET SIEN=$$SCHEMA("UPDATE PROCEDURES")
+4 ; GET SCHEMA
DO SS^BMXADO(.OUT,SIEN,"","")
+5 SET NODE=$ORDER(^TMP("BMX ADO",$JOB,999999),-1)+1
+6 SET ^TMP("BMX ADO",$JOB,NODE)="^`2198^`"_DFN_"^`71164^`8718"_$CHAR(30)
+7 DO DISP(OUT)
READ %:$GET(DTIME,60)
+8 DO BAFM^BMXADOF1(.OUT,$NAME(^TMP("BMX ADO",$JOB)))
+9 KILL ^TMP("BMX ADO",$JOB)
+10 WRITE !!,OUT
SET %=0
FOR
SET %=$ORDER(OUT(%))
IF '%
QUIT
WRITE !,OUT(%)
+11 QUIT
+12 ;
CPT ; DISPLAY CPT CODES
+1 NEW OUT,%,SIEN,DFN
+2 SET VIEN=71164
+3 SET SIEN=$$SCHEMA("VIEW CPT")
+4 DO SS^BMXADO(.OUT,SIEN,"","AD~"_VIEN_"~"_VIEN_"~10~~~~")
+5 DO DISP(OUT)
READ %:$GET(DTIME,60)
+6 KILL ^TMP("BMX ADO",$JOB)
+7 QUIT
+8 ;
ADDCPT ; UPDATE V CPT FILE
+1 NEW OUT,%,SIEN,DFN,NODE
+2 SET DFN=1
+3 SET SIEN=$$SCHEMA("UPDATE CPT")
+4 ; GET SCHEMA
DO SS^BMXADO(.OUT,SIEN,"","")
+5 SET NODE=$ORDER(^TMP("BMX ADO",$JOB,999999),-1)+1
+6 SET ^TMP("BMX ADO",$JOB,NODE)="^`10000^`"_DFN_"^`71164^WOUND CARE"_$CHAR(30)
+7 DO DISP(OUT)
READ %:$GET(DTIME,60)
+8 DO BAFM^BMXADOF1(.OUT,$NAME(^TMP("BMX ADO",$JOB)))
+9 KILL ^TMP("BMX ADO",$JOB)
+10 WRITE !!,OUT
SET %=0
FOR
SET %=$ORDER(OUT(%))
IF '%
QUIT
WRITE !,OUT(%)
+11 QUIT
+12 ;
PH ; DISPLAY PERSONAL HISTORY
+1 NEW OUT,%,SIEN,DFN
+2 SET DFN=632
+3 SET SIEN=$$SCHEMA("VIEW PERSONAL HISTORY")
+4 DO SS^BMXADO(.OUT,SIEN,"","AC~"_DFN_"~"_DFN_"~~~~~")
+5 DO DISP(OUT)
READ %:$GET(DTIME,60)
+6 KILL ^TMP("BMX ADO",$JOB)
+7 QUIT
+8 ;
ADDPH ; UPDATE PERSONAL HX
+1 NEW OUT,%,SIEN,DFN,NODE,ICD,TEXT
+2 SET ICD=2477
+3 SET TEXT="PERSONAL HISTORY OF SERIOUS PROBLEMS"
+4 SET DFN=632
+5 SET SIEN=$$SCHEMA("UPDATE PERSONAL HISTORY")
+6 ; GET SCHEMA
DO SS^BMXADO(.OUT,SIEN,"","")
+7 SET NODE=$ORDER(^TMP("BMX ADO",$JOB,999999),-1)+1
+8 SET ^TMP("BMX ADO",$JOB,NODE)="^`11353^`"_DFN_"^2851219^"_TEXT_"^2810303"_$CHAR(30)
+9 DO DISP(OUT)
READ %:$GET(DTIME,60)
+10 DO BAFM^BMXADOF1(.OUT,$NAME(^TMP("BMX ADO",$JOB)))
+11 KILL ^TMP("BMX ADO",$JOB)
+12 WRITE !!,OUT
SET %=0
FOR
SET %=$ORDER(OUT(%))
IF '%
QUIT
WRITE !,OUT(%)
+13 QUIT
+14 ;
FH ; DISPLAY FAMILY HX
+1 NEW OUT,%,SIEN,DFN
+2 SET DFN=631
+3 SET SIEN=$$SCHEMA("VIEW FAMILY HISTORY")
+4 DO SS^BMXADO(.OUT,SIEN,"","AC~"_DFN_"~"_DFN_"~~~~~")
+5 DO DISP(OUT)
READ %:$GET(DTIME,60)
+6 KILL ^TMP("BMX ADO",$JOB)
+7 QUIT
+8 ;
ADDFH ; UPDATE FAMILY HISTORY
+1 NEW OUT,%,SIEN,DFN,NODE,ICD,TEXT
+2 SET ICD=2477
+3 SET TEXT="FAMILY HISTORY OF SERIOUS PROBLEMS"
+4 SET DFN=631
+5 SET SIEN=$$SCHEMA("UPDATE FAMILY HISTORY")
+6 ; GET SCHEMA
DO SS^BMXADO(.OUT,SIEN,"","")
+7 SET NODE=$ORDER(^TMP("BMX ADO",$JOB,999999),-1)+1
+8 SET ^TMP("BMX ADO",$JOB,NODE)="^`7571^`"_DFN_"^2851219^"_TEXT_$CHAR(30)
+9 DO DISP(OUT)
READ %:$GET(DTIME,60)
+10 DO BAFM^BMXADOF1(.OUT,$NAME(^TMP("BMX ADO",$JOB)))
+11 KILL ^TMP("BMX ADO",$JOB)
+12 WRITE !!,OUT
SET %=0
FOR
SET %=$ORDER(OUT(%))
IF '%
QUIT
WRITE !,OUT(%)
+13 QUIT
+14 ;
HF ; DISPLAY HEALTH FACTORS
+1 NEW OUT,%,SIEN,DFN
+2 SET DFN=1
+3 SET SIEN=$$SCHEMA("VIEW HEALTH FACTORS")
+4 DO SS^BMXADO(.OUT,SIEN,"","AC"_"~"_DFN_"~"_DFN_"~~~~~")
+5 DO DISP(OUT)
READ %:$GET(DTIME,60)
+6 KILL ^TMP("BMX ADO",$JOB)
+7 QUIT
+8 ;
ADDHF ; UPDATE HEALTH FACTORS FILE
+1 NEW OUT,%,SIEN,DFN,NODE
+2 SET DFN=1
+3 SET SIEN=$$SCHEMA("UPDATE HEALTH FACTORS")
+4 ; GET SCHEMA
DO SS^BMXADO(.OUT,SIEN,"","")
+5 SET NODE=$ORDER(^TMP("BMX ADO",$JOB,999999),-1)+1
+6 SET ^TMP("BMX ADO",$JOB,NODE)="^`3^`"_DFN_U_DT_$CHAR(30)
+7 DO DISP(OUT)
READ %:$GET(DTIME,60)
+8 DO BAFM^BMXADOF1(.OUT,$NAME(^TMP("BMX ADO",$JOB)))
+9 KILL ^TMP("BMX ADO",$JOB)
+10 WRITE !!,OUT
SET %=0
FOR
SET %=$ORDER(OUT(%))
IF '%
QUIT
WRITE !,OUT(%)
+11 QUIT
+12 ;
REPRO ; DISPLAY REPRODUCTIVE FACTORS
+1 NEW OUT,%,SIEN,DFN
+2 SET DFN=5
+3 SET SIEN=$$SCHEMA("VIEW REPRODUCTIVE FACTORS")
+4 DO SS^BMXADO(.OUT,SIEN,"","B"_"~"_DFN_"~"_DFN_"~~~~~")
+5 DO DISP(OUT)
READ %:$GET(DTIME,60)
+6 KILL ^TMP("BMX ADO",$JOB)
+7 QUIT
+8 ;
ADDREPRO ; UPDATE REPRODUCTIVE FACTORS
+1 ; THE .O1 FIELD IS DINUMED
+2 ; THEREFORE, THE FILER WILL AUTOMATICALLY SWITCH TO MOD MODE IF A RECORD ALREADY EXISTS FOR THIS PATIENT
+3 NEW OUT,%,SIEN,DFN,NODE
+4 SET DFN=5
+5 ; I $D(^AUPNREP(DFN)) G ERF
+6 SET SIEN=$$SCHEMA("ADD REPRODUCTIVE FACTORS")
+7 ; GET SCHEMA
DO SS^BMXADO(.OUT,SIEN,"","")
+8 SET NODE=$ORDER(^TMP("BMX ADO",$JOB,999999),-1)+1
+9 SET ^TMP("BMX ADO",$JOB,NODE)="^`"_DFN_"^G5P4LC3SA1TA0^"_DT_"^2^3040101^"_DT_$CHAR(30)
+10 DO DISP(OUT)
READ %:$GET(DTIME,60)
+11 DO BAFM^BMXADOF1(.OUT,$NAME(^TMP("BMX ADO",$JOB)))
+12 KILL ^TMP("BMX ADO",$JOB)
+13 WRITE !!,OUT
SET %=0
FOR
SET %=$ORDER(OUT(%))
IF '%
QUIT
WRITE !,OUT(%)
+14 QUIT
+15 ;
+16 ; ---------------------------------- GRIDS ---------------------------------------------
+17 ;
GRID ; POPULATE THE INTRO GRID
+1 NEW OUT,%,SIEN,NODE,NEXT
+2 SET NEXT="70470;0"
+3 SET SIEN=$$SCHEMA("VEN MOJO DE INTRO")
+4 ; GET SCHEMA
DO SS^BMXADO(.OUT,SIEN,"","ASEG~"_NEXT_"~"_NEXT)
+5 DO DISP(OUT)
READ %:$GET(DTIME,60)
+6 KILL ^TMP("BMX ADO",$JOB)
+7 QUIT
+8 ;
MGRID ; POPULATE THE MEASUREMENT GRID
+1 NEW OUT,%,SIEN,NODE,NEXT,START,STOP
+2 SET NEXT="70470;2"
+3 SET SIEN=$$SCHEMA("VEN MOJO DE MEASUREMENT")
+4 ; D SS^BMXADO(.OUT,SIEN,"","~~~~~GRIDIT~VENPCCTG~"_NEXT) ; GET SCHEMA
+5 ; GET SCHEMA
DO SS^BMXADO(.OUT,SIEN,"","ASEG~"_NEXT_"~"_NEXT)
+6 DO DISP(OUT)
READ %:$GET(DTIME,60)
+7 ; K ^TMP("BMX ADO",$J)
+8 QUIT
+9 ;
PRVGRID ; POPULATE THE PROVIDER GRID
+1 NEW OUT,%,SIEN,NODE,NEXT
+2 SET NEXT="70470;4"
+3 SET SIEN=$$SCHEMA("VEN MOJO DE PROVIDER")
+4 ; GET SCHEMA
DO SS^BMXADO(.OUT,SIEN,"","ASEG~"_NEXT_"~"_NEXT)
+5 DO DISP(OUT)
READ %:$GET(DTIME,60)
+6 KILL ^TMP("BMX ADO",$JOB)
+7 QUIT
+8 ;
CLGRID ; POPULATE THE CLINIC GRID
+1 NEW OUT,%,SIEN,NODE,NEXT
+2 SET NEXT="70470;8"
+3 SET SIEN=$$SCHEMA("VEN MOJO DE CLINIC")
+4 ; GET SCHEMA
DO SS^BMXADO(.OUT,SIEN,"","ASEG~"_NEXT_"~"_NEXT)
+5 DO DISP(OUT)
READ %:$GET(DTIME,60)
+6 KILL ^TMP("BMX ADO",$JOB)
+7 QUIT
+8 ;
DXGRID ; POPULATE THE DX GRID
+1 NEW OUT,%,SIEN,NODE,NEXT
+2 SET NEXT="70470;1"
+3 SET SIEN=$$SCHEMA("VEN MOJO DE DX DXHX")
+4 ; GET SCHEMA
DO SS^BMXADO(.OUT,SIEN,"","ASEG~"_NEXT_"~"_NEXT)
+5 DO DISP(OUT)
READ %:$GET(DTIME,60)
+6 KILL ^TMP("BMX ADO",$JOB)
+7 QUIT
+8 ;