BMXADOXX ; IHS/CIHA/GIS - RPC CALL: GENERATE AN ADO SCHEMA STRING AND DATA SET ;
;;4.0;BMX;**4**;JUN 28, 2010;Build 4
; EXAMPLES OF RPMS SCHEMA GENERATION
;
;
ADDPAT ;
N OUT,%,SIEN,DFN,NODE
;S DFN=9285
S SIEN=$$SCHEMA("UPDATE VA PATIENT")
D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
S ^TMP("BMX ADO",$J,NODE)="^KANGAROO,KAP^M^1-1-83^151515555"_$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
;
DISP(OUT) ; 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=1373,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=322
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=96
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=9285
S SIEN=$$SCHEMA("VISITS")
D SS^BMXADO(.OUT,SIEN,"","AA~3/21/1968~6/4/2004~100~~~~9285|C")
D DISP(OUT) R %:$G(DTIME,60)
K ^TMP("BMX ADO",$J)
Q
;
DUPVIS ; DISPLAY POSSIBLE DUPLICATE VISITS
N OUT,%,SIEN,DFN
S DFN=9285
S SIEN=$$SCHEMA("VISITS")
D SS^BMXADO(.OUT,SIEN,"","~~~~~DUPV~BMXADOV2~9285|5/24/04@1PM|I|516|~")
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=9285
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@01:32^I^`9285^`516^A^`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
;
POV ; DISPLAY POVS
Q ;Deactivated in patch BMX*4.0*3 due to structure changes
N OUT,%,SIEN,DFN,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
;
S DIR("A",1)="",DIR("A")="Enter the DFN to check: "
S DIR(0)="FA^1:98"
D ^DIR I '+Y Q
S DFN=Y
;
S SIEN=$$SCHEMA("VIEW POVS")
D SS^BMXADO(.OUT,SIEN,"","AA~3/21/1965~6/4/2004~100~~~~9285|C")
D DISP(OUT)
K ^TMP("BMX ADO",$J)
Q
;
ADDPOV ; ADD A POV TO AN EXISITING VISIT
Q ;Deactivated in patch BMX*4.0*3 due to structure changes
;
EDITPOV ; ADD A POV TO AN EXISITING VISIT
Q ;Deactivated in patch BMX*4.0*3 due to structure changes
;
PROB ; DISPLAY PROBLEMS
Q ;Deactivated in patch BMX*4.0*3 due to structure changes
N OUT,%,SIEN,DFN,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
S DIR("A",1)="",DIR("A")="Enter the DFN to check: "
S DIR(0)="FA^1:98"
D ^DIR I '+Y Q
S DFN=Y
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
Q ;Deactivated in patch BMX*4.0*3 due to structure changes
;
MEAS ; DISPLAY MEASUREMENTS
N OUT,%,SIEN,DFN
S DFN=2
S SIEN=$$SCHEMA("VIEW MEASUREMENTS")
D SS^BMXADO(.OUT,SIEN,"","AA~3/21/1965~6/4/2004~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=2
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_"^`7806^172.75"_$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=152
S SIEN=$$SCHEMA("VIEW MEDS")
D SS^BMXADO(.OUT,SIEN,"","AA~1/1/1969~12/31/2004~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=2
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_"^`7806^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=280
S SIEN=$$SCHEMA("VIEW LABS")
D SS^BMXADO(.OUT,SIEN,"","AA~1/1/1965~12/31/2003~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=2
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_"^`7806^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=1373
S SIEN=$$SCHEMA("VIEW EXAMS")
D SS^BMXADO(.OUT,SIEN,"","AA~1/1/1966~12/31/2003~10~~~~"_DFN_"|6|C")
D DISP(OUT) R %:$G(DTIME,60)
K ^TMP("BMX ADO",$J)
Q
;
ADDEXAMS ; UPDATE V EXAM
S DFN=2
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_"^`7806^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=54
S SIEN=$$SCHEMA("VIEW IMM")
D SS^BMXADO(.OUT,SIEN,"","AA~1/1/1966~12/31/2003~10~~~~"_DFN_"|101|C")
D DISP(OUT) R %:$G(DTIME,60)
K ^TMP("BMX ADO",$J)
Q
;
PROV ; DISPLAY PROVIDERS FOR A VISIT
N OUT,%,SIEN,VIEN
S VIEN=4703
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=DUZ,DFN=2
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_"^`7806^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=235
S SIEN=$$SCHEMA("VIEW PROCEDURES")
D SS^BMXADO(.OUT,SIEN,"","AA~1/1/1965~12/31/2003~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=2
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_"^`7806^`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=41151
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=2
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_"^`7806"_$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
Q ;Deactivated in patch BMX*4.0*3 due to structure changes
N OUT,%,SIEN,DFN,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
S DIR("A",1)="",DIR("A")="Enter the DFN to check: "
S DIR(0)="FA^1:98"
D ^DIR I '+Y Q
S DFN=Y
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
Q ;Deactivated in patch BMX*4.0*3 due to structure changes
N OUT,%,SIEN,DFN,NODE,ICD,TEXT
S ICD=2477
S TEXT="PERSONAL HISTORY OF SERIOUS PROBLEMS"
S DFN=2
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 ; TEST - DISPLAY FAMILY HX
Q ;Deactivated in patch BMX*4.0*3 due to structure changes
N OUT,%,SIEN,DFN,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
S DIR("A",1)="",DIR("A")="Enter the DFN to check: "
S DIR(0)="FA^1:98"
D ^DIR I '+Y Q
S DFN=Y
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
Q ;Deactivated in patch BMX*4.0*3 due to structure changes
N OUT,%,SIEN,DFN,NODE,ICD,TEXT
S ICD=2477
S TEXT="FAMILY HISTORY OF SERIOUS PROBLEMS"
S DFN=2
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=2390
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=2
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
Q ;Deactivated in patch BMX*4.0*3 due to structure changes
N OUT,%,SIEN,DFN
S DFN=1373
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
Q ;Deactivated in patch BMX*4.0*3 due to structure changes
; 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=2
; I $D(^AUPNREP(DFN)) G ERF
S SIEN=$$SCHEMA("UPDATE 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
;
BMXADOXX ; IHS/CIHA/GIS - RPC CALL: GENERATE AN ADO SCHEMA STRING AND DATA SET ;
+1 ;;4.0;BMX;**4**;JUN 28, 2010;Build 4
+2 ; EXAMPLES OF RPMS SCHEMA GENERATION
+3 ;
+4 ;
ADDPAT ;
+1 NEW OUT,%,SIEN,DFN,NODE
+2 ;S DFN=9285
+3 SET SIEN=$$SCHEMA("UPDATE VA PATIENT")
+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)="^KANGAROO,KAP^M^1-1-83^151515555"_$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 ;
+12 QUIT
+13 ;
DISP(OUT) ; 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=1373
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=322
+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=96
+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=9285
+3 SET SIEN=$$SCHEMA("VISITS")
+4 DO SS^BMXADO(.OUT,SIEN,"","AA~3/21/1968~6/4/2004~100~~~~9285|C")
+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=9285
+3 SET SIEN=$$SCHEMA("VISITS")
+4 DO SS^BMXADO(.OUT,SIEN,"","~~~~~DUPV~BMXADOV2~9285|5/24/04@1PM|I|516|~")
+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=9285
+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@01:32^I^`9285^`516^A^`2"_$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 ;Deactivated in patch BMX*4.0*3 due to structure changes
QUIT
+2 NEW OUT,%,SIEN,DFN,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
+3 ;
+4 SET DIR("A",1)=""
SET DIR("A")="Enter the DFN to check: "
+5 SET DIR(0)="FA^1:98"
+6 DO ^DIR
IF '+Y
QUIT
+7 SET DFN=Y
+8 ;
+9 SET SIEN=$$SCHEMA("VIEW POVS")
+10 DO SS^BMXADO(.OUT,SIEN,"","AA~3/21/1965~6/4/2004~100~~~~9285|C")
+11 DO DISP(OUT)
+12 KILL ^TMP("BMX ADO",$JOB)
+13 QUIT
+14 ;
ADDPOV ; ADD A POV TO AN EXISITING VISIT
+1 ;Deactivated in patch BMX*4.0*3 due to structure changes
QUIT
+2 ;
EDITPOV ; ADD A POV TO AN EXISITING VISIT
+1 ;Deactivated in patch BMX*4.0*3 due to structure changes
QUIT
+2 ;
PROB ; DISPLAY PROBLEMS
+1 ;Deactivated in patch BMX*4.0*3 due to structure changes
QUIT
+2 NEW OUT,%,SIEN,DFN,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
+3 SET DIR("A",1)=""
SET DIR("A")="Enter the DFN to check: "
+4 SET DIR(0)="FA^1:98"
+5 DO ^DIR
IF '+Y
QUIT
+6 SET DFN=Y
+7 SET SIEN=$$SCHEMA("VIEW PROBLEMS")
+8 DO SS^BMXADO(.OUT,SIEN,"","AA~"_DFN_"~"_DFN_"~~~~~")
+9 DO DISP(OUT)
READ %:$GET(DTIME,60)
+10 KILL ^TMP("BMX ADO",$JOB)
+11 QUIT
+12 ;
ADDPROB ; ADD A PROBLEM TO THE PROBLEM LIST
+1 ;Deactivated in patch BMX*4.0*3 due to structure changes
QUIT
+2 ;
MEAS ; DISPLAY MEASUREMENTS
+1 NEW OUT,%,SIEN,DFN
+2 SET DFN=2
+3 SET SIEN=$$SCHEMA("VIEW MEASUREMENTS")
+4 DO SS^BMXADO(.OUT,SIEN,"","AA~3/21/1965~6/4/2004~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=2
+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_"^`7806^172.75"_$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=152
+3 SET SIEN=$$SCHEMA("VIEW MEDS")
+4 DO SS^BMXADO(.OUT,SIEN,"","AA~1/1/1969~12/31/2004~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=2
+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_"^`7806^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=280
+3 SET SIEN=$$SCHEMA("VIEW LABS")
+4 DO SS^BMXADO(.OUT,SIEN,"","AA~1/1/1965~12/31/2003~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=2
+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_"^`7806^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=1373
+3 SET SIEN=$$SCHEMA("VIEW EXAMS")
+4 DO SS^BMXADO(.OUT,SIEN,"","AA~1/1/1966~12/31/2003~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=2
+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_"^`7806^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=54
+3 SET SIEN=$$SCHEMA("VIEW IMM")
+4 DO SS^BMXADO(.OUT,SIEN,"","AA~1/1/1966~12/31/2003~10~~~~"_DFN_"|101|C")
+5 DO DISP(OUT)
READ %:$GET(DTIME,60)
+6 KILL ^TMP("BMX ADO",$JOB)
+7 QUIT
+8 ;
PROV ; DISPLAY PROVIDERS FOR A VISIT
+1 NEW OUT,%,SIEN,VIEN
+2 SET VIEN=4703
+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=DUZ
SET DFN=2
+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_"^`7806^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=235
+3 SET SIEN=$$SCHEMA("VIEW PROCEDURES")
+4 DO SS^BMXADO(.OUT,SIEN,"","AA~1/1/1965~12/31/2003~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=2
+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_"^`7806^`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=41151
+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=2
+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_"^`7806"_$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 ;Deactivated in patch BMX*4.0*3 due to structure changes
QUIT
+2 NEW OUT,%,SIEN,DFN,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
+3 SET DIR("A",1)=""
SET DIR("A")="Enter the DFN to check: "
+4 SET DIR(0)="FA^1:98"
+5 DO ^DIR
IF '+Y
QUIT
+6 SET DFN=Y
+7 SET SIEN=$$SCHEMA("VIEW PERSONAL HISTORY")
+8 DO SS^BMXADO(.OUT,SIEN,"","AC~"_DFN_"~"_DFN_"~~~~~")
+9 DO DISP(OUT)
READ %:$GET(DTIME,60)
+10 KILL ^TMP("BMX ADO",$JOB)
+11 QUIT
+12 ;
ADDPH ; UPDATE PERSONAL HX
+1 ;Deactivated in patch BMX*4.0*3 due to structure changes
QUIT
+2 NEW OUT,%,SIEN,DFN,NODE,ICD,TEXT
+3 SET ICD=2477
+4 SET TEXT="PERSONAL HISTORY OF SERIOUS PROBLEMS"
+5 SET DFN=2
+6 SET SIEN=$$SCHEMA("UPDATE PERSONAL HISTORY")
+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)="^`11353^`"_DFN_"^2851219^"_TEXT_"^2810303"_$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 ;
FH ; TEST - DISPLAY FAMILY HX
+1 ;Deactivated in patch BMX*4.0*3 due to structure changes
QUIT
+2 NEW OUT,%,SIEN,DFN,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
+3 SET DIR("A",1)=""
SET DIR("A")="Enter the DFN to check: "
+4 SET DIR(0)="FA^1:98"
+5 DO ^DIR
IF '+Y
QUIT
+6 SET DFN=Y
+7 SET SIEN=$$SCHEMA("VIEW FAMILY HISTORY")
+8 DO SS^BMXADO(.OUT,SIEN,"","AC~"_DFN_"~"_DFN_"~~~~~")
+9 DO DISP(OUT)
READ %:$GET(DTIME,60)
+10 KILL ^TMP("BMX ADO",$JOB)
+11 QUIT
+12 ;
ADDFH ; UPDATE FAMILY HISTORY
+1 ;Deactivated in patch BMX*4.0*3 due to structure changes
QUIT
+2 NEW OUT,%,SIEN,DFN,NODE,ICD,TEXT
+3 SET ICD=2477
+4 SET TEXT="FAMILY HISTORY OF SERIOUS PROBLEMS"
+5 SET DFN=2
+6 SET SIEN=$$SCHEMA("UPDATE FAMILY HISTORY")
+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)="^`7571^`"_DFN_"^2851219^"_TEXT_$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 ;
HF ; DISPLAY HEALTH FACTORS
+1 NEW OUT,%,SIEN,DFN
+2 SET DFN=2390
+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=2
+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 ;Deactivated in patch BMX*4.0*3 due to structure changes
QUIT
+2 NEW OUT,%,SIEN,DFN
+3 SET DFN=1373
+4 SET SIEN=$$SCHEMA("VIEW REPRODUCTIVE FACTORS")
+5 DO SS^BMXADO(.OUT,SIEN,"","B"_"~"_DFN_"~"_DFN_"~~~~~")
+6 DO DISP(OUT)
READ %:$GET(DTIME,60)
+7 KILL ^TMP("BMX ADO",$JOB)
+8 QUIT
+9 ;
ADDREPRO ; UPDATE REPRODUCTIVE FACTORS
+1 ;Deactivated in patch BMX*4.0*3 due to structure changes
QUIT
+2 ; THE .O1 FIELD IS DINUMED
+3 ; THEREFORE, THE FILER WILL AUTOMATICALLY SWITCH TO MOD MODE IF A RECORD ALREADY EXISTS FOR THIS PATIENT
+4 NEW OUT,%,SIEN,DFN,NODE
+5 SET DFN=2
+6 ; I $D(^AUPNREP(DFN)) G ERF
+7 SET SIEN=$$SCHEMA("UPDATE REPRODUCTIVE FACTORS")
+8 ; GET SCHEMA
DO SS^BMXADO(.OUT,SIEN,"","")
+9 SET NODE=$ORDER(^TMP("BMX ADO",$JOB,999999),-1)+1
+10 SET ^TMP("BMX ADO",$JOB,NODE)="^`"_DFN_"^G5P4LC3SA1TA0^"_DT_"^2^3040101^"_DT_$CHAR(30)
+11 DO DISP(OUT)
READ %:$GET(DTIME,60)
+12 DO BAFM^BMXADOF1(.OUT,$NAME(^TMP("BMX ADO",$JOB)))
+13 KILL ^TMP("BMX ADO",$JOB)
+14 WRITE !!,OUT
SET %=0
FOR
SET %=$ORDER(OUT(%))
IF '%
QUIT
WRITE !,OUT(%)
+15 QUIT
+16 ;
