BQIPTREP ;VNGT/HS/ALA - Patient Reproductive Factors ; 06 May 2008 7:40 PM
;;2.3;ICARE MANAGEMENT SYSTEM;;Apr 18, 2012;Build 59
;
REP(DATA,DFN) ; EP -- BQI PATIENT REPRODUCTIVE FACS
;
;Description - all the reproductive factors that a patient has
;
;Input
; DFN - Patient internal entry number
;
NEW UID,II,RDATA,BQINT,BQEXT,SEX,RFLMP,RFGRAV,RFPARI,RFFTB,RFPTB
NEW RFEDCDT,RFAMENS,RFAMENP,RFDESDS,RFEDCMD,RFCFPM,RFLD,RDES,RDATA,AGE,N
NEW RCFPMDB,RCFPMDE,RFECTPG,RFEDCMDT,RFLMPD,RFSPBOR,RFTABOR,RPCON,RPCONDT
NEW RPHIS,RPHISDT,VER,RFLIVC,RFCPREG,RFPRDT,RFDT,RPCONMBG,RFCFPMDT
NEW RFCOIT,RFMULPRT,RFSXTRMA,ACTIVE,RFFPBDT,RFFPEDT,RFFPMT,RFLACT
;
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIPTREP",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTREP D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S SEX=$$GET1^DIQ(2,DFN_",",.02,"I"),AGE=$$AGE^BQIAGE(DFN)
I SEX'="F" D Q
. S @DATA@(II)="I00010RESULT^T00080MESSAGE"_$C(30)
. S II=II+1,@DATA@(II)="-1^RPC Failed: Patient is not Female"_$C(30)
. S II=II+1,@DATA@(II)=$C(31)
;
S RDATA=""
S @DATA@(II)="T00010COLUMN_NAME^T00045COLUMN_DESC^T00120COLUMN_VALUE^D00015DATE_LAST_MODIFIED^T00075PRV_LAST_MODIFIED"_$C(30)
; Get data from file
D GETS^DIQ(9000017,DFN_",","*","I","BQINT")
D GETS^DIQ(9000017,DFN_",","*","E","BQEXT")
S RFLMP=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",2,"I"))) I RFLMP'="" S RDATA=1
S RFLMPD=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",2.1,"I"))) I RFLMPD'="" S RDATA=1,RFDT("RFLMP")=RFLMPD
;
; Check the version of software
S VER=$$VERSION^XPDUTL("IHS PCC SUITE")
I VER<2.0 D
. S RFEDCDT=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",4,"I"))) I RFEDCDT'="" S RDATA=1
. S RFEDCMD=$G(BQEXT(9000017,DFN_",",4.05,"E")) I RFEDCMD'="" S RDATA=1
. S RFEDCMDT=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",4.1,"I"))) I RFEDCMDT'="" S RDATA=1
. S RPHIS=$G(BQEXT(9000017,DFN_",",1,"E")) I RPHIS'="" S RDATA=1
. S RPHISDT=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",1.1,"I"))) I RPHISDT'="" S RDATA=1
. S RPCONDT=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",3.1,"I"))) I RPCONDT'="" S RDATA=1
. S RPCONMBG=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",3.05,"I"))) I RPCONMBG'="" S RDATA=1
. S RPCON=$G(BQEXT(9000017,DFN_",",3,"E")) I RPCON'="" S RDATA=1
I VER>1.0 D
. S RFGRAV=$G(BQEXT(9000017,DFN_",",1103,"E"))
. I RFGRAV'="" S RDATA=1,RFDT("RFGRAV")=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",1104,"I")))
. S RFLACT=$G(BQEXT(9000017,DFN_",",2.01,"E")),ACTIVE("RFLACT")=""
. I RFLACT'="" S RDATA=1,RFDT("RFLACT")=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",2.02,"I")))
. S RFPARI=$G(BQEXT(9000017,DFN_",",1105,"E"))
. I RFPARI'="" S RDATA=1,RFDT("RFPARI")=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",1106,"I")))
. S RFFTB=$G(BQEXT(9000017,DFN_",",1107,"E"))
. I RFFTB'="" S RDATA=1,RFDT("RFFTB")=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",1108,"I")))
. S RFPTB=$G(BQEXT(9000017,DFN_",",1109,"E"))
. I RFPTB'="" S RDATA=1,RFDT("RFPTB")=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",1110,"I")))
. S RFECTPG=$G(BQEXT(9000017,DFN_",",1111,"E"))
. I RFECTPG'="" S RDATA=1,RFDT("RFECTPG")=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",1112,"I")))
. S RFTABOR=$G(BQEXT(9000017,DFN_",",1131,"E"))
. I RFTABOR'="" S RDATA=1,RFDT("RFTABOR")=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",1132,"I")))
. S RFSPBOR=$G(BQEXT(9000017,DFN_",",1133,"E"))
. I RFSPBOR'="" S RDATA=1,RFDT("RFSPBOR")=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",1134,"I")))
. S RFLIVC=$G(BQEXT(9000017,DFN_",",1113,"E"))
. I RFLIVC'="" S RDATA=1,RFDT("RFLIVC")=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",1114,"I")))
. I $E($$GET1^DID(9000017,1101,"","LABEL"),1)'="*" D
.. S RFCPREG=$G(BQEXT(9000017,DFN_",",1101,"E")),ACTIVE("RFCPREG")=""
.. I RFCPREG'="" S RDATA=1,RFDT("RFCPREG")=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",1102,"I")))
.. I RFCPREG="YES" D ;Only display EDC if current pregnancy status is YES
... I $E($$GET1^DID(9000017,4,"","LABEL"),1)="*" S INACTIVE("RFEDCDT")="",INACTIVE("RFEDCMD")=""
... I $E($$GET1^DID(9000017,4,"","LABEL"),1)'="*" D
.... S RFEDCDT=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",4,"I"))) I RFEDCDT'="" S RDATA=1
.... S RFEDCMD=$G(BQINT(9000017,DFN_",",4.05,"I"))_$C(28)_$G(BQEXT(9000017,DFN_",",4.05,"E")) I RFEDCMD'=$C(28) S RDATA=1
.... ;S RFPRDT=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",1102,"I"))) I RFPRDT'="" S RDATA=1
. I $E($$GET1^DID(9000017,1101,"","LABEL"),1)="*" D
.. S RFEDCDT=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",4,"I"))) I RFEDCDT'="" S RDATA=1
.. S RFEDCMD=$G(BQEXT(9000017,DFN_",",4.05,"E")) I RFEDCMD'="" S RDATA=1
.. S RFDT("RFEDCDT")=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",4.1,"I")))
. I $E($$GET1^DID(9000017,1117,"","LABEL"),1)'="*" D
.. S RFAMENS=$G(BQEXT(9000017,DFN_",",1117,"E")),ACTIVE("RFAMENS")=""
.. I RFAMENS'="" S RDATA=1,RFDT("RFAMENS")=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",1118,"I")))
. I $E($$GET1^DID(9000017,1121,"","LABEL"),1)'="*" D
.. S RFAMENP=$G(BQEXT(9000017,DFN_",",1121,"E")),ACTIVE("RFAMENP")=""
.. I RFAMENP'="" S RDATA=1,RFDT("RFAMENP")=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",1122,"I")))
. I $E($$GET1^DID(9000017,1127,"","LABEL"),1)'="*" D
.. S RFDESDS=$G(BQEXT(9000017,DFN_",",1127,"E")),ACTIVE("RFDESDS")=""
.. I RFDESDS'="" S RDATA=1,RFDT("RFDESDS")=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",1128,"I")))
. I $E($$GET1^DID(9000017,1119,"","LABEL"),1)'="*" D
.. S RFCOIT=$G(BQEXT(9000017,DFN_",",1119,"E")),ACTIVE("RFCOIT")=""
.. I RFCOIT'="" S RDATA=1,RFDT("RFCOIT")=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",1120,"I")))
. I $E($$GET1^DID(9000017,1125,"","LABEL"),1)'="*" D
.. S RFMULPRT=$G(BQEXT(9000017,DFN_",",1125,"E")),ACTIVE("RFMULPRT")=""
.. I RFMULPRT'="" S RDATA=1,RFDT("RFMULPRT")=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",1126,"I")))
. I $E($$GET1^DID(9000017,1123,"","LABEL"),1)'="*" D
.. S RFSXTRMA=$G(BQEXT(9000017,DFN_",",1123,"E")),ACTIVE("RFSXTRMA")=""
.. I RFSXTRMA'="" S RDATA=1,RFDT("RFSXTRMA")=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",1124,"I")))
. ;
. ; Contraceptive Methods
. S RFCFPM=""
. I $E($$GET1^DID(9000017,2101,"","LABEL"),1)="*" D
.. S RFCFPM=$G(BQEXT(9000017,DFN_",",3,"E"))
.. S RFCFPMDT=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",3.05,"I")))
.. S RFDT("RFCFPM")=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",3.1,"I")))
. I $E($$GET1^DID(9000017,2101,"","LABEL"),1)'="*" S N=0 D
.. ;S (ACTIVE("RFFPMT"),ACTIVE("RFFPBDT"),ACTIVE("RFFPEDT"))=""
.. F S N=$O(^AUPNREP(DFN,2101,N)) Q:'N D
... NEW DA,IENS
... S DA(1)=DFN,DA=N,IENS=$$IENS^DILF(.DA)
... I $$GET1^DIQ(9000017.02101,IENS,.05,"E")'="" Q
... S RFFPBDT=$$GET1^DIQ(9000017.02101,IENS,.02,"I") I RFFPBDT'="" S RDATA=1
... S RFCFUPD=$$GET1^DIQ(9000017.02101,IENS,.04,"I")
... S RFCMCMT=$$GET1^DIQ(9000017.02101,IENS,.06,"3")
... ;S RFFPEDT=$$GET1^DIQ(9000017.02101,IENS,.03,"I") I RFFPEDT'="" S RDATA=1
... ;I RFFPBDT="",RFFPEDT="" Q
... ;S RFFPMT=$$GET1^DIQ(9000017.02101,IENS,.01,"E")_"("_$$FMTE^BQIUL1(RFFPBDT)_"-"_$$FMTE^BQIUL1(RFFPEDT)_")"
... S RFCFPM=$$GET1^DIQ(9000017.02101,IENS,.01,"E")_$S(RFCMCMT'="":" ("_RFCMCMT_")",1:"")
... S RFCFPMDT=$$FMTE^BQIUL1(RFFPBDT),RFDT("RFCFPM")=$$FMTE^BQIUL1(RFCFUPD)
I 'RDATA,AGE<10 D Q
. S @DATA@(II)="I00010RESULT^T00080MESSAGE"_$C(30)
. S II=II+1,@DATA@(II)="-1^RPC Failed: Patient is less than 10 years of age"_$C(30)
. S II=II+1,@DATA@(II)=$C(31)
;
I VER<2.0 D G DONE
. S II=II+1,@DATA@(II)="DFN^Patient^"_DFN_U_U_$C(30)
. S II=II+1,@DATA@(II)="RFLMP^Last Menstrual Period (LMP)^"_RFLMP_U_RFLMPD_U_$C(30)
. S II=II+1,@DATA@(II)="RFEDCMD^EDC^"_RFEDCMD_U_RFEDCMDT_U_$C(30)
. S II=II+1,@DATA@(II)="RPHIS^Reproductive History^"_RPHIS_U_RPHISDT_U_$C(30)
. S II=II+1,@DATA@(II)="RPCON^Contraception Method^"_RPCON_U_RPCONDT_U_$C(30)
. S II=II+1,@DATA@(II)="RPCONMBG^Current Contraception Begun^"_RPCONMBG_U_$C(30)
. ;S II=II+1,@DATA@(II)="RPHIS^Reproductive History^"_RPHIS_U_RPHISDT_$C(30)
. ;S II=II+1,@DATA@(II)="RFLMP^Last Menstrual Period (LMP)^"_RFLMP_U_RFLMPD_U_$C(30)
. ;S II=II+1,@DATA@(II)="RPCON^Contraception Method^"_RPCON_U_RPCONDT_U_$C(30)
. ;S II=II+1,@DATA@(II)="RFEDCMD^EDC Method^"_RFEDCMD_U_RFEDCMDT_U_$C(30)
. ;S II=II+1,@DATA@(II)="RFEDCDT^Estimated Date of Confinement (EDC) Date^"_RFEDCDT_U_RFEDCMDT_U_$C(30)
;
D RDES
D:$D(ACTIVE) ACTIVATE(.ACTIVE)
F RFLD="DFN","RFLMP","RFCPREG","RFLACT","RFCFPM","RFCFPMDT","RFEDDDT","RFEDCMD" I $D(@RFLD) S II=II+1,@DATA@(II)=RFLD_U_RDES(RFLD)_U_@RFLD_U_$G(RFDT(RFLD))_U_$C(30)
;F RFLD="DFN","RFLMP","RFCFPM","RFCFPMDT","RFEDCDT","RFEDCMD" I $D(@RFLD) S II=II+1,@DATA@(II)=RFLD_U_RDES(RFLD)_U_@RFLD_U_$G(RFDT(RFLD))_U_$C(30)
F RFLD="RFGRAV","RFFTB","RFPTB" I $D(@RFLD) S II=II+1,@DATA@(II)=RFLD_U_RDES(RFLD)_U_@RFLD_U_$G(RFDT(RFLD))_U_$C(30)
F RFLD="RFSPBOR","RFTABOR","RFECTPG","RFLIVC" I $D(@RFLD) S II=II+1,@DATA@(II)=RFLD_U_RDES(RFLD)_U_@RFLD_U_$G(RFDT(RFLD))_U_$C(30)
F RFLD="RFPARI" I $D(@RFLD) S II=II+1,@DATA@(II)=RFLD_U_RDES(RFLD)_U_@RFLD_U_$G(RFDT(RFLD))_U_$C(30)
;F RFLD="RFCPREG" I $D(@RFLD) S II=II+1,@DATA@(II)=RFLD_U_RDES(RFLD)_U_@RFLD_U_$G(RFDT(RFLD))_U_$C(30)
F RFLD="RFAMENS","RFCOIT","RFAMENP","RFDESDS" I $D(@RFLD) S II=II+1,@DATA@(II)=RFLD_U_RDES(RFLD)_U_@RFLD_U_$G(RFDT(RFLD))_U_$C(30)
F RFLD="RFMULPRT","RFSXTRMA" I $D(@RFLD) S II=II+1,@DATA@(II)=RFLD_U_RDES(RFLD)_U_@RFLD_U_$G(RFDT(RFLD))_U_$C(30)
;F RFLD="RFLACT" I $D(@RFLD) S II=II+1,@DATA@(II)=RFLD_U_RDES(RFLD)_U_@RFLD_U_$G(RFDT(RFLD))_U_$C(30)
;
DONE ;
S II=II+1,@DATA@(II)=$C(31)
Q
;
RDES ; Load report descriptions
S RDES("DFN")="Patient"
S RDES("RFLMP")="Last Menstrual Period (LMP)"
S RDES("RFGRAV")="Total Number of Pregnancies"
S RDES("RFPARI")="Multiple Births"
S RDES("RFFTB")="Full Term Births"
S RDES("RFPTB")="Premature Births"
S RDES("RFECTPG")="Ectopic Pregnancies"
S RDES("RFTABOR")="Abortions, Induced"
S RDES("RFSPBOR")="Abortions, Spontaneous"
S RDES("RFLIVC")="Living Children"
S RDES("RFCPREG")="Current Pregnancy Status"
;S RDES("RFPRDT")="Pregnancy Status ""as of"" date"
S RDES("RFLACT")="Lactation Status"
S RDES("RFEDCDT")="Estimated Due Date"
S RDES("RFEDCMD")="EDD Method"
S RDES("RFAMENS")="Age at First Menses"
S RDES("RFAMENP")="Age at Menopause Onset"
S RDES("RFDESDS")="DES Daughter Status"
S RDES("RFCFPM")="Current Contraception Method"
S RDES("RFCFPMDT")="Current Contraception Begun"
S RDES("RFCOIT")="Age at first sexual intercouse"
S RDES("RFMULPRT")="Multiple Sexual Partners?"
S RDES("RFSXTRMA")="History of Sexual Trauma?"
S RDES("RFEDDDT")="Definitive EDD"
Q
;
ACTIVATE(ACTIVE) ;
; ACTIVE = array of CODE name references to make active at 90506.31,.11
; each element in the array maps to the CODE defined at 90506.31,.07
; logic activates the fields in DISPLAY COLUMNS subfile of the ICARE FILE DEFINITION
; for the REPRODUCTIVE FACTORS entry including the FAMILY PLANNING METHOD subfile entry of REPRODUCTIVE FACTORS
N RFCODE,VDEFILE,VDEFDA,RFCDDA,VDEFIENS,DA
S (VDEFDA,RFCDDA)=0,RFCODE=""
F VDEFILE="9000017","9000017.02101" D
. S VDEFDA=$O(^BQI(90506.3,"C",VDEFILE,"")) Q:'VDEFDA
. S DA(1)=VDEFDA
. F S RFCODE=$O(ACTIVE(RFCODE)) Q:RFCODE="" D
.. S RFCDDA=+$O(^BQI(90506.3,VDEFDA,10,"AC",RFCODE,"")) Q:'RFCDDA
.. S DA=RFCDDA,VDEFIENS=$$IENS^DILF(.DA)
.. ;S BQINEW(90506.31,VDEFIENS,.11)=$S($G(ACTIVE):"@",1:1)
.. S BQINEW(90506.31,VDEFIENS,.11)="@"
.. K ACTIVE(RFCODE)
. F S RFCODE=$O(INACTIVE(RFCODE)) Q:RFCODE="" D
.. S RFCDDA=+$O(^BQI(90506.3,VDEFDA,10,"AC",RFCODE,"")) Q:'RFCDDA
.. S DA=RFCDDA,VDEFIENS=$$IENS^DILF(.DA)
.. S BQINEW(90506.31,VDEFIENS,.11)=1
.. K INACTIVE(RFCODE)
D FILE^DIE("","BQINEW","ERROR")
Q
;
ERR ;
D ^%ZTER
NEW Y,ERRDTM
S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
S BMXSEC="Recording that an error occurred at "_ERRDTM
I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
Q
BQIPTREP ;VNGT/HS/ALA - Patient Reproductive Factors ; 06 May 2008 7:40 PM
+1 ;;2.3;ICARE MANAGEMENT SYSTEM;;Apr 18, 2012;Build 59
+2 ;
REP(DATA,DFN) ; EP -- BQI PATIENT REPRODUCTIVE FACS
+1 ;
+2 ;Description - all the reproductive factors that a patient has
+3 ;
+4 ;Input
+5 ; DFN - Patient internal entry number
+6 ;
+7 NEW UID,II,RDATA,BQINT,BQEXT,SEX,RFLMP,RFGRAV,RFPARI,RFFTB,RFPTB
+8 NEW RFEDCDT,RFAMENS,RFAMENP,RFDESDS,RFEDCMD,RFCFPM,RFLD,RDES,RDATA,AGE,N
+9 NEW RCFPMDB,RCFPMDE,RFECTPG,RFEDCMDT,RFLMPD,RFSPBOR,RFTABOR,RPCON,RPCONDT
+10 NEW RPHIS,RPHISDT,VER,RFLIVC,RFCPREG,RFPRDT,RFDT,RPCONMBG,RFCFPMDT
+11 NEW RFCOIT,RFMULPRT,RFSXTRMA,ACTIVE,RFFPBDT,RFFPEDT,RFFPMT,RFLACT
+12 ;
+13 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+14 SET DATA=$NAME(^TMP("BQIPTREP",UID))
+15 KILL @DATA
+16 ;
+17 SET II=0
+18 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIPTREP D UNWIND^%ZTER"
+19 ;
+20 SET SEX=$$GET1^DIQ(2,DFN_",",.02,"I")
SET AGE=$$AGE^BQIAGE(DFN)
+21 IF SEX'="F"
Begin DoDot:1
+22 SET @DATA@(II)="I00010RESULT^T00080MESSAGE"_$CHAR(30)
+23 SET II=II+1
SET @DATA@(II)="-1^RPC Failed: Patient is not Female"_$CHAR(30)
+24 SET II=II+1
SET @DATA@(II)=$CHAR(31)
End DoDot:1
QUIT
+25 ;
+26 SET RDATA=""
+27 SET @DATA@(II)="T00010COLUMN_NAME^T00045COLUMN_DESC^T00120COLUMN_VALUE^D00015DATE_LAST_MODIFIED^T00075PRV_LAST_MODIFIED"_$CHAR(30)
+28 ; Get data from file
+29 DO GETS^DIQ(9000017,DFN_",","*","I","BQINT")
+30 DO GETS^DIQ(9000017,DFN_",","*","E","BQEXT")
+31 SET RFLMP=$$FMTE^BQIUL1($GET(BQINT(9000017,DFN_",",2,"I")))
IF RFLMP'=""
SET RDATA=1
+32 SET RFLMPD=$$FMTE^BQIUL1($GET(BQINT(9000017,DFN_",",2.1,"I")))
IF RFLMPD'=""
SET RDATA=1
SET RFDT("RFLMP")=RFLMPD
+33 ;
+34 ; Check the version of software
+35 SET VER=$$VERSION^XPDUTL("IHS PCC SUITE")
+36 IF VER<2.0
Begin DoDot:1
+37 SET RFEDCDT=$$FMTE^BQIUL1($GET(BQINT(9000017,DFN_",",4,"I")))
IF RFEDCDT'=""
SET RDATA=1
+38 SET RFEDCMD=$GET(BQEXT(9000017,DFN_",",4.05,"E"))
IF RFEDCMD'=""
SET RDATA=1
+39 SET RFEDCMDT=$$FMTE^BQIUL1($GET(BQINT(9000017,DFN_",",4.1,"I")))
IF RFEDCMDT'=""
SET RDATA=1
+40 SET RPHIS=$GET(BQEXT(9000017,DFN_",",1,"E"))
IF RPHIS'=""
SET RDATA=1
+41 SET RPHISDT=$$FMTE^BQIUL1($GET(BQINT(9000017,DFN_",",1.1,"I")))
IF RPHISDT'=""
SET RDATA=1
+42 SET RPCONDT=$$FMTE^BQIUL1($GET(BQINT(9000017,DFN_",",3.1,"I")))
IF RPCONDT'=""
SET RDATA=1
+43 SET RPCONMBG=$$FMTE^BQIUL1($GET(BQINT(9000017,DFN_",",3.05,"I")))
IF RPCONMBG'=""
SET RDATA=1
+44 SET RPCON=$GET(BQEXT(9000017,DFN_",",3,"E"))
IF RPCON'=""
SET RDATA=1
End DoDot:1
+45 IF VER>1.0
Begin DoDot:1
+46 SET RFGRAV=$GET(BQEXT(9000017,DFN_",",1103,"E"))
+47 IF RFGRAV'=""
SET RDATA=1
SET RFDT("RFGRAV")=$$FMTE^BQIUL1($GET(BQINT(9000017,DFN_",",1104,"I")))
+48 SET RFLACT=$GET(BQEXT(9000017,DFN_",",2.01,"E"))
SET ACTIVE("RFLACT")=""
+49 IF RFLACT'=""
SET RDATA=1
SET RFDT("RFLACT")=$$FMTE^BQIUL1($GET(BQINT(9000017,DFN_",",2.02,"I")))
+50 SET RFPARI=$GET(BQEXT(9000017,DFN_",",1105,"E"))
+51 IF RFPARI'=""
SET RDATA=1
SET RFDT("RFPARI")=$$FMTE^BQIUL1($GET(BQINT(9000017,DFN_",",1106,"I")))
+52 SET RFFTB=$GET(BQEXT(9000017,DFN_",",1107,"E"))
+53 IF RFFTB'=""
SET RDATA=1
SET RFDT("RFFTB")=$$FMTE^BQIUL1($GET(BQINT(9000017,DFN_",",1108,"I")))
+54 SET RFPTB=$GET(BQEXT(9000017,DFN_",",1109,"E"))
+55 IF RFPTB'=""
SET RDATA=1
SET RFDT("RFPTB")=$$FMTE^BQIUL1($GET(BQINT(9000017,DFN_",",1110,"I")))
+56 SET RFECTPG=$GET(BQEXT(9000017,DFN_",",1111,"E"))
+57 IF RFECTPG'=""
SET RDATA=1
SET RFDT("RFECTPG")=$$FMTE^BQIUL1($GET(BQINT(9000017,DFN_",",1112,"I")))
+58 SET RFTABOR=$GET(BQEXT(9000017,DFN_",",1131,"E"))
+59 IF RFTABOR'=""
SET RDATA=1
SET RFDT("RFTABOR")=$$FMTE^BQIUL1($GET(BQINT(9000017,DFN_",",1132,"I")))
+60 SET RFSPBOR=$GET(BQEXT(9000017,DFN_",",1133,"E"))
+61 IF RFSPBOR'=""
SET RDATA=1
SET RFDT("RFSPBOR")=$$FMTE^BQIUL1($GET(BQINT(9000017,DFN_",",1134,"I")))
+62 SET RFLIVC=$GET(BQEXT(9000017,DFN_",",1113,"E"))
+63 IF RFLIVC'=""
SET RDATA=1
SET RFDT("RFLIVC")=$$FMTE^BQIUL1($GET(BQINT(9000017,DFN_",",1114,"I")))
+64 IF $EXTRACT($$GET1^DID(9000017,1101,"","LABEL"),1)'="*"
Begin DoDot:2
+65 SET RFCPREG=$GET(BQEXT(9000017,DFN_",",1101,"E"))
SET ACTIVE("RFCPREG")=""
+66 IF RFCPREG'=""
SET RDATA=1
SET RFDT("RFCPREG")=$$FMTE^BQIUL1($GET(BQINT(9000017,DFN_",",1102,"I")))
+67 ;Only display EDC if current pregnancy status is YES
IF RFCPREG="YES"
Begin DoDot:3
+68 IF $EXTRACT($$GET1^DID(9000017,4,"","LABEL"),1)="*"
SET INACTIVE("RFEDCDT")=""
SET INACTIVE("RFEDCMD")=""
+69 IF $EXTRACT($$GET1^DID(9000017,4,"","LABEL"),1)'="*"
Begin DoDot:4
+70 SET RFEDCDT=$$FMTE^BQIUL1($GET(BQINT(9000017,DFN_",",4,"I")))
IF RFEDCDT'=""
SET RDATA=1
+71 SET RFEDCMD=$GET(BQINT(9000017,DFN_",",4.05,"I"))_$CHAR(28)_$GET(BQEXT(9000017,DFN_",",4.05,"E"))
IF RFEDCMD'=$CHAR(28)
SET RDATA=1
+72 ;S RFPRDT=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",1102,"I"))) I RFPRDT'="" S RDATA=1
End DoDot:4
End DoDot:3
End DoDot:2
+73 IF $EXTRACT($$GET1^DID(9000017,1101,"","LABEL"),1)="*"
Begin DoDot:2
+74 SET RFEDCDT=$$FMTE^BQIUL1($GET(BQINT(9000017,DFN_",",4,"I")))
IF RFEDCDT'=""
SET RDATA=1
+75 SET RFEDCMD=$GET(BQEXT(9000017,DFN_",",4.05,"E"))
IF RFEDCMD'=""
SET RDATA=1
+76 SET RFDT("RFEDCDT")=$$FMTE^BQIUL1($GET(BQINT(9000017,DFN_",",4.1,"I")))
End DoDot:2
+77 IF $EXTRACT($$GET1^DID(9000017,1117,"","LABEL"),1)'="*"
Begin DoDot:2
+78 SET RFAMENS=$GET(BQEXT(9000017,DFN_",",1117,"E"))
SET ACTIVE("RFAMENS")=""
+79 IF RFAMENS'=""
SET RDATA=1
SET RFDT("RFAMENS")=$$FMTE^BQIUL1($GET(BQINT(9000017,DFN_",",1118,"I")))
End DoDot:2
+80 IF $EXTRACT($$GET1^DID(9000017,1121,"","LABEL"),1)'="*"
Begin DoDot:2
+81 SET RFAMENP=$GET(BQEXT(9000017,DFN_",",1121,"E"))
SET ACTIVE("RFAMENP")=""
+82 IF RFAMENP'=""
SET RDATA=1
SET RFDT("RFAMENP")=$$FMTE^BQIUL1($GET(BQINT(9000017,DFN_",",1122,"I")))
End DoDot:2
+83 IF $EXTRACT($$GET1^DID(9000017,1127,"","LABEL"),1)'="*"
Begin DoDot:2
+84 SET RFDESDS=$GET(BQEXT(9000017,DFN_",",1127,"E"))
SET ACTIVE("RFDESDS")=""
+85 IF RFDESDS'=""
SET RDATA=1
SET RFDT("RFDESDS")=$$FMTE^BQIUL1($GET(BQINT(9000017,DFN_",",1128,"I")))
End DoDot:2
+86 IF $EXTRACT($$GET1^DID(9000017,1119,"","LABEL"),1)'="*"
Begin DoDot:2
+87 SET RFCOIT=$GET(BQEXT(9000017,DFN_",",1119,"E"))
SET ACTIVE("RFCOIT")=""
+88 IF RFCOIT'=""
SET RDATA=1
SET RFDT("RFCOIT")=$$FMTE^BQIUL1($GET(BQINT(9000017,DFN_",",1120,"I")))
End DoDot:2
+89 IF $EXTRACT($$GET1^DID(9000017,1125,"","LABEL"),1)'="*"
Begin DoDot:2
+90 SET RFMULPRT=$GET(BQEXT(9000017,DFN_",",1125,"E"))
SET ACTIVE("RFMULPRT")=""
+91 IF RFMULPRT'=""
SET RDATA=1
SET RFDT("RFMULPRT")=$$FMTE^BQIUL1($GET(BQINT(9000017,DFN_",",1126,"I")))
End DoDot:2
+92 IF $EXTRACT($$GET1^DID(9000017,1123,"","LABEL"),1)'="*"
Begin DoDot:2
+93 SET RFSXTRMA=$GET(BQEXT(9000017,DFN_",",1123,"E"))
SET ACTIVE("RFSXTRMA")=""
+94 IF RFSXTRMA'=""
SET RDATA=1
SET RFDT("RFSXTRMA")=$$FMTE^BQIUL1($GET(BQINT(9000017,DFN_",",1124,"I")))
End DoDot:2
+95 ;
+96 ; Contraceptive Methods
+97 SET RFCFPM=""
+98 IF $EXTRACT($$GET1^DID(9000017,2101,"","LABEL"),1)="*"
Begin DoDot:2
+99 SET RFCFPM=$GET(BQEXT(9000017,DFN_",",3,"E"))
+100 SET RFCFPMDT=$$FMTE^BQIUL1($GET(BQINT(9000017,DFN_",",3.05,"I")))
+101 SET RFDT("RFCFPM")=$$FMTE^BQIUL1($GET(BQINT(9000017,DFN_",",3.1,"I")))
End DoDot:2
+102 IF $EXTRACT($$GET1^DID(9000017,2101,"","LABEL"),1)'="*"
SET N=0
Begin DoDot:2
+103 ;S (ACTIVE("RFFPMT"),ACTIVE("RFFPBDT"),ACTIVE("RFFPEDT"))=""
+104 FOR
SET N=$ORDER(^AUPNREP(DFN,2101,N))
IF 'N
QUIT
Begin DoDot:3
+105 NEW DA,IENS
+106 SET DA(1)=DFN
SET DA=N
SET IENS=$$IENS^DILF(.DA)
+107 IF $$GET1^DIQ(9000017.02101,IENS,.05,"E")'=""
QUIT
+108 SET RFFPBDT=$$GET1^DIQ(9000017.02101,IENS,.02,"I")
IF RFFPBDT'=""
SET RDATA=1
+109 SET RFCFUPD=$$GET1^DIQ(9000017.02101,IENS,.04,"I")
+110 SET RFCMCMT=$$GET1^DIQ(9000017.02101,IENS,.06,"3")
+111 ;S RFFPEDT=$$GET1^DIQ(9000017.02101,IENS,.03,"I") I RFFPEDT'="" S RDATA=1
+112 ;I RFFPBDT="",RFFPEDT="" Q
+113 ;S RFFPMT=$$GET1^DIQ(9000017.02101,IENS,.01,"E")_"("_$$FMTE^BQIUL1(RFFPBDT)_"-"_$$FMTE^BQIUL1(RFFPEDT)_")"
+114 SET RFCFPM=$$GET1^DIQ(9000017.02101,IENS,.01,"E")_$SELECT(RFCMCMT'="":" ("_RFCMCMT_")",1:"")
+115 SET RFCFPMDT=$$FMTE^BQIUL1(RFFPBDT)
SET RFDT("RFCFPM")=$$FMTE^BQIUL1(RFCFUPD)
End DoDot:3
End DoDot:2
End DoDot:1
+116 IF 'RDATA
IF AGE<10
Begin DoDot:1
+117 SET @DATA@(II)="I00010RESULT^T00080MESSAGE"_$CHAR(30)
+118 SET II=II+1
SET @DATA@(II)="-1^RPC Failed: Patient is less than 10 years of age"_$CHAR(30)
+119 SET II=II+1
SET @DATA@(II)=$CHAR(31)
End DoDot:1
QUIT
+120 ;
+121 IF VER<2.0
Begin DoDot:1
+122 SET II=II+1
SET @DATA@(II)="DFN^Patient^"_DFN_U_U_$CHAR(30)
+123 SET II=II+1
SET @DATA@(II)="RFLMP^Last Menstrual Period (LMP)^"_RFLMP_U_RFLMPD_U_$CHAR(30)
+124 SET II=II+1
SET @DATA@(II)="RFEDCMD^EDC^"_RFEDCMD_U_RFEDCMDT_U_$CHAR(30)
+125 SET II=II+1
SET @DATA@(II)="RPHIS^Reproductive History^"_RPHIS_U_RPHISDT_U_$CHAR(30)
+126 SET II=II+1
SET @DATA@(II)="RPCON^Contraception Method^"_RPCON_U_RPCONDT_U_$CHAR(30)
+127 SET II=II+1
SET @DATA@(II)="RPCONMBG^Current Contraception Begun^"_RPCONMBG_U_$CHAR(30)
+128 ;S II=II+1,@DATA@(II)="RPHIS^Reproductive History^"_RPHIS_U_RPHISDT_$C(30)
+129 ;S II=II+1,@DATA@(II)="RFLMP^Last Menstrual Period (LMP)^"_RFLMP_U_RFLMPD_U_$C(30)
+130 ;S II=II+1,@DATA@(II)="RPCON^Contraception Method^"_RPCON_U_RPCONDT_U_$C(30)
+131 ;S II=II+1,@DATA@(II)="RFEDCMD^EDC Method^"_RFEDCMD_U_RFEDCMDT_U_$C(30)
+132 ;S II=II+1,@DATA@(II)="RFEDCDT^Estimated Date of Confinement (EDC) Date^"_RFEDCDT_U_RFEDCMDT_U_$C(30)
End DoDot:1
GOTO DONE
+133 ;
+134 DO RDES
+135 IF $DATA(ACTIVE)
DO ACTIVATE(.ACTIVE)
+136 FOR RFLD="DFN","RFLMP","RFCPREG","RFLACT","RFCFPM","RFCFPMDT","RFEDDDT","RFEDCMD"
IF $DATA(@RFLD)
SET II=II+1
SET @DATA@(II)=RFLD_U_RDES(RFLD)_U_@RFLD_U_$GET(RFDT(RFLD))_U_$CHAR(30)
+137 ;F RFLD="DFN","RFLMP","RFCFPM","RFCFPMDT","RFEDCDT","RFEDCMD" I $D(@RFLD) S II=II+1,@DATA@(II)=RFLD_U_RDES(RFLD)_U_@RFLD_U_$G(RFDT(RFLD))_U_$C(30)
+138 FOR RFLD="RFGRAV","RFFTB","RFPTB"
IF $DATA(@RFLD)
SET II=II+1
SET @DATA@(II)=RFLD_U_RDES(RFLD)_U_@RFLD_U_$GET(RFDT(RFLD))_U_$CHAR(30)
+139 FOR RFLD="RFSPBOR","RFTABOR","RFECTPG","RFLIVC"
IF $DATA(@RFLD)
SET II=II+1
SET @DATA@(II)=RFLD_U_RDES(RFLD)_U_@RFLD_U_$GET(RFDT(RFLD))_U_$CHAR(30)
+140 FOR RFLD="RFPARI"
IF $DATA(@RFLD)
SET II=II+1
SET @DATA@(II)=RFLD_U_RDES(RFLD)_U_@RFLD_U_$GET(RFDT(RFLD))_U_$CHAR(30)
+141 ;F RFLD="RFCPREG" I $D(@RFLD) S II=II+1,@DATA@(II)=RFLD_U_RDES(RFLD)_U_@RFLD_U_$G(RFDT(RFLD))_U_$C(30)
+142 FOR RFLD="RFAMENS","RFCOIT","RFAMENP","RFDESDS"
IF $DATA(@RFLD)
SET II=II+1
SET @DATA@(II)=RFLD_U_RDES(RFLD)_U_@RFLD_U_$GET(RFDT(RFLD))_U_$CHAR(30)
+143 FOR RFLD="RFMULPRT","RFSXTRMA"
IF $DATA(@RFLD)
SET II=II+1
SET @DATA@(II)=RFLD_U_RDES(RFLD)_U_@RFLD_U_$GET(RFDT(RFLD))_U_$CHAR(30)
+144 ;F RFLD="RFLACT" I $D(@RFLD) S II=II+1,@DATA@(II)=RFLD_U_RDES(RFLD)_U_@RFLD_U_$G(RFDT(RFLD))_U_$C(30)
+145 ;
DONE ;
+1 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+2 QUIT
+3 ;
RDES ; Load report descriptions
+1 SET RDES("DFN")="Patient"
+2 SET RDES("RFLMP")="Last Menstrual Period (LMP)"
+3 SET RDES("RFGRAV")="Total Number of Pregnancies"
+4 SET RDES("RFPARI")="Multiple Births"
+5 SET RDES("RFFTB")="Full Term Births"
+6 SET RDES("RFPTB")="Premature Births"
+7 SET RDES("RFECTPG")="Ectopic Pregnancies"
+8 SET RDES("RFTABOR")="Abortions, Induced"
+9 SET RDES("RFSPBOR")="Abortions, Spontaneous"
+10 SET RDES("RFLIVC")="Living Children"
+11 SET RDES("RFCPREG")="Current Pregnancy Status"
+12 ;S RDES("RFPRDT")="Pregnancy Status ""as of"" date"
+13 SET RDES("RFLACT")="Lactation Status"
+14 SET RDES("RFEDCDT")="Estimated Due Date"
+15 SET RDES("RFEDCMD")="EDD Method"
+16 SET RDES("RFAMENS")="Age at First Menses"
+17 SET RDES("RFAMENP")="Age at Menopause Onset"
+18 SET RDES("RFDESDS")="DES Daughter Status"
+19 SET RDES("RFCFPM")="Current Contraception Method"
+20 SET RDES("RFCFPMDT")="Current Contraception Begun"
+21 SET RDES("RFCOIT")="Age at first sexual intercouse"
+22 SET RDES("RFMULPRT")="Multiple Sexual Partners?"
+23 SET RDES("RFSXTRMA")="History of Sexual Trauma?"
+24 SET RDES("RFEDDDT")="Definitive EDD"
+25 QUIT
+26 ;
ACTIVATE(ACTIVE) ;
+1 ; ACTIVE = array of CODE name references to make active at 90506.31,.11
+2 ; each element in the array maps to the CODE defined at 90506.31,.07
+3 ; logic activates the fields in DISPLAY COLUMNS subfile of the ICARE FILE DEFINITION
+4 ; for the REPRODUCTIVE FACTORS entry including the FAMILY PLANNING METHOD subfile entry of REPRODUCTIVE FACTORS
+5 NEW RFCODE,VDEFILE,VDEFDA,RFCDDA,VDEFIENS,DA
+6 SET (VDEFDA,RFCDDA)=0
SET RFCODE=""
+7 FOR VDEFILE="9000017","9000017.02101"
Begin DoDot:1
+8 SET VDEFDA=$ORDER(^BQI(90506.3,"C",VDEFILE,""))
IF 'VDEFDA
QUIT
+9 SET DA(1)=VDEFDA
+10 FOR
SET RFCODE=$ORDER(ACTIVE(RFCODE))
IF RFCODE=""
QUIT
Begin DoDot:2
+11 SET RFCDDA=+$ORDER(^BQI(90506.3,VDEFDA,10,"AC",RFCODE,""))
IF 'RFCDDA
QUIT
+12 SET DA=RFCDDA
SET VDEFIENS=$$IENS^DILF(.DA)
+13 ;S BQINEW(90506.31,VDEFIENS,.11)=$S($G(ACTIVE):"@",1:1)
+14 SET BQINEW(90506.31,VDEFIENS,.11)="@"
+15 KILL ACTIVE(RFCODE)
End DoDot:2
+16 FOR
SET RFCODE=$ORDER(INACTIVE(RFCODE))
IF RFCODE=""
QUIT
Begin DoDot:2
+17 SET RFCDDA=+$ORDER(^BQI(90506.3,VDEFDA,10,"AC",RFCODE,""))
IF 'RFCDDA
QUIT
+18 SET DA=RFCDDA
SET VDEFIENS=$$IENS^DILF(.DA)
+19 SET BQINEW(90506.31,VDEFIENS,.11)=1
+20 KILL INACTIVE(RFCODE)
End DoDot:2
End DoDot:1
+21 DO FILE^DIE("","BQINEW","ERROR")
+22 QUIT
+23 ;
ERR ;
+1 DO ^%ZTER
+2 NEW Y,ERRDTM
+3 SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET ERRDTM=Y
+4 SET BMXSEC="Recording that an error occurred at "_ERRDTM
+5 IF $DATA(II)
IF $DATA(DATA)
SET II=II+1
SET @DATA@(II)=$CHAR(31)
+6 QUIT
