Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BQIPTREP

BQIPTREP.m

Go to the documentation of this file. 
  1. BQIPTREP ;VNGT/HS/ALA - Patient Reproductive Factors ; 06 May 2008  7:40 PM
  1.  ;;2.3;ICARE MANAGEMENT SYSTEM;;Apr 18, 2012;Build 59
  1.  ;
  1. REP(DATA,DFN) ; EP -- BQI PATIENT REPRODUCTIVE FACS
  1.  ;
  1.  ;Description - all the reproductive factors that a patient has
  1.  ;
  1.  ;Input
  1.  ;  DFN - Patient internal entry number
  1.  ;
  1.  NEW UID,II,RDATA,BQINT,BQEXT,SEX,RFLMP,RFGRAV,RFPARI,RFFTB,RFPTB
  1.  NEW RFEDCDT,RFAMENS,RFAMENP,RFDESDS,RFEDCMD,RFCFPM,RFLD,RDES,RDATA,AGE,N
  1.  NEW RCFPMDB,RCFPMDE,RFECTPG,RFEDCMDT,RFLMPD,RFSPBOR,RFTABOR,RPCON,RPCONDT
  1.  NEW RPHIS,RPHISDT,VER,RFLIVC,RFCPREG,RFPRDT,RFDT,RPCONMBG,RFCFPMDT
  1.  NEW RFCOIT,RFMULPRT,RFSXTRMA,ACTIVE,RFFPBDT,RFFPEDT,RFFPMT,RFLACT
  1.  ;
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIPTREP",UID))
  1.  K @DATA
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTREP D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S SEX=$$GET1^DIQ(2,DFN_",",.02,"I"),AGE=$$AGE^BQIAGE(DFN)
  1.  I SEX'="F" D  Q
  1.  . S @DATA@(II)="I00010RESULT^T00080MESSAGE"_$C(30)
  1.  . S II=II+1,@DATA@(II)="-1^RPC Failed: Patient is not Female"_$C(30)
  1.  . S II=II+1,@DATA@(II)=$C(31)
  1.  ;
  1.  S RDATA=""
  1.  S @DATA@(II)="T00010COLUMN_NAME^T00045COLUMN_DESC^T00120COLUMN_VALUE^D00015DATE_LAST_MODIFIED^T00075PRV_LAST_MODIFIED"_$C(30)
  1.  ; Get data from file
  1.  D GETS^DIQ(9000017,DFN_",","*","I","BQINT")
  1.  D GETS^DIQ(9000017,DFN_",","*","E","BQEXT")
  1.  S RFLMP=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",2,"I"))) I RFLMP'="" S RDATA=1
  1.  S RFLMPD=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",2.1,"I"))) I RFLMPD'="" S RDATA=1,RFDT("RFLMP")=RFLMPD
  1.  ;
  1.  ; Check the version of software
  1.  S VER=$$VERSION^XPDUTL("IHS PCC SUITE")
  1.  I VER<2.0 D
  1.  . S RFEDCDT=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",4,"I"))) I RFEDCDT'="" S RDATA=1
  1.  . S RFEDCMD=$G(BQEXT(9000017,DFN_",",4.05,"E")) I RFEDCMD'="" S RDATA=1
  1.  . S RFEDCMDT=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",4.1,"I"))) I RFEDCMDT'="" S RDATA=1
  1.  . S RPHIS=$G(BQEXT(9000017,DFN_",",1,"E")) I RPHIS'="" S RDATA=1
  1.  . S RPHISDT=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",1.1,"I"))) I RPHISDT'="" S RDATA=1
  1.  . S RPCONDT=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",3.1,"I"))) I RPCONDT'="" S RDATA=1
  1.  . S RPCONMBG=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",3.05,"I"))) I RPCONMBG'="" S RDATA=1
  1.  . S RPCON=$G(BQEXT(9000017,DFN_",",3,"E")) I RPCON'="" S RDATA=1
  1.  I VER>1.0 D
  1.  . S RFGRAV=$G(BQEXT(9000017,DFN_",",1103,"E"))
  1.  . I RFGRAV'="" S RDATA=1,RFDT("RFGRAV")=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",1104,"I")))
  1.  . S RFLACT=$G(BQEXT(9000017,DFN_",",2.01,"E")),ACTIVE("RFLACT")=""
  1.  . I RFLACT'="" S RDATA=1,RFDT("RFLACT")=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",2.02,"I")))
  1.  . S RFPARI=$G(BQEXT(9000017,DFN_",",1105,"E"))
  1.  . I RFPARI'="" S RDATA=1,RFDT("RFPARI")=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",1106,"I")))
  1.  . S RFFTB=$G(BQEXT(9000017,DFN_",",1107,"E"))
  1.  . I RFFTB'="" S RDATA=1,RFDT("RFFTB")=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",1108,"I")))
  1.  . S RFPTB=$G(BQEXT(9000017,DFN_",",1109,"E"))
  1.  . I RFPTB'="" S RDATA=1,RFDT("RFPTB")=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",1110,"I")))
  1.  . S RFECTPG=$G(BQEXT(9000017,DFN_",",1111,"E"))
  1.  . I RFECTPG'="" S RDATA=1,RFDT("RFECTPG")=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",1112,"I")))
  1.  . S RFTABOR=$G(BQEXT(9000017,DFN_",",1131,"E"))
  1.  . I RFTABOR'="" S RDATA=1,RFDT("RFTABOR")=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",1132,"I")))
  1.  . S RFSPBOR=$G(BQEXT(9000017,DFN_",",1133,"E"))
  1.  . I RFSPBOR'="" S RDATA=1,RFDT("RFSPBOR")=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",1134,"I")))
  1.  . S RFLIVC=$G(BQEXT(9000017,DFN_",",1113,"E"))
  1.  . I RFLIVC'="" S RDATA=1,RFDT("RFLIVC")=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",1114,"I")))
  1.  . I $E($$GET1^DID(9000017,1101,"","LABEL"),1)'="*" D
  1.  .. S RFCPREG=$G(BQEXT(9000017,DFN_",",1101,"E")),ACTIVE("RFCPREG")=""
  1.  .. I RFCPREG'="" S RDATA=1,RFDT("RFCPREG")=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",1102,"I")))
  1.  .. I RFCPREG="YES" D  ;Only display EDC if current pregnancy status is YES
  1.  ... I $E($$GET1^DID(9000017,4,"","LABEL"),1)="*" S INACTIVE("RFEDCDT")="",INACTIVE("RFEDCMD")=""
  1.  ... I $E($$GET1^DID(9000017,4,"","LABEL"),1)'="*" D
  1.  .... S RFEDCDT=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",4,"I"))) I RFEDCDT'="" S RDATA=1
  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
  1.  .... ;S RFPRDT=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",1102,"I"))) I RFPRDT'="" S RDATA=1
  1.  . I $E($$GET1^DID(9000017,1101,"","LABEL"),1)="*" D
  1.  .. S RFEDCDT=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",4,"I"))) I RFEDCDT'="" S RDATA=1
  1.  .. S RFEDCMD=$G(BQEXT(9000017,DFN_",",4.05,"E")) I RFEDCMD'="" S RDATA=1
  1.  .. S RFDT("RFEDCDT")=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",4.1,"I")))
  1.  . I $E($$GET1^DID(9000017,1117,"","LABEL"),1)'="*" D
  1.  .. S RFAMENS=$G(BQEXT(9000017,DFN_",",1117,"E")),ACTIVE("RFAMENS")=""
  1.  .. I RFAMENS'="" S RDATA=1,RFDT("RFAMENS")=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",1118,"I")))
  1.  . I $E($$GET1^DID(9000017,1121,"","LABEL"),1)'="*" D
  1.  .. S RFAMENP=$G(BQEXT(9000017,DFN_",",1121,"E")),ACTIVE("RFAMENP")=""
  1.  .. I RFAMENP'="" S RDATA=1,RFDT("RFAMENP")=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",1122,"I")))
  1.  . I $E($$GET1^DID(9000017,1127,"","LABEL"),1)'="*" D
  1.  .. S RFDESDS=$G(BQEXT(9000017,DFN_",",1127,"E")),ACTIVE("RFDESDS")=""
  1.  .. I RFDESDS'="" S RDATA=1,RFDT("RFDESDS")=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",1128,"I")))
  1.  . I $E($$GET1^DID(9000017,1119,"","LABEL"),1)'="*" D
  1.  .. S RFCOIT=$G(BQEXT(9000017,DFN_",",1119,"E")),ACTIVE("RFCOIT")=""
  1.  .. I RFCOIT'="" S RDATA=1,RFDT("RFCOIT")=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",1120,"I")))
  1.  . I $E($$GET1^DID(9000017,1125,"","LABEL"),1)'="*" D
  1.  .. S RFMULPRT=$G(BQEXT(9000017,DFN_",",1125,"E")),ACTIVE("RFMULPRT")=""
  1.  .. I RFMULPRT'="" S RDATA=1,RFDT("RFMULPRT")=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",1126,"I")))
  1.  . I $E($$GET1^DID(9000017,1123,"","LABEL"),1)'="*" D
  1.  .. S RFSXTRMA=$G(BQEXT(9000017,DFN_",",1123,"E")),ACTIVE("RFSXTRMA")=""
  1.  .. I RFSXTRMA'="" S RDATA=1,RFDT("RFSXTRMA")=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",1124,"I")))
  1.  . ;
  1.  . ; Contraceptive Methods
  1.  . S RFCFPM=""
  1.  . I $E($$GET1^DID(9000017,2101,"","LABEL"),1)="*" D
  1.  .. S RFCFPM=$G(BQEXT(9000017,DFN_",",3,"E"))
  1.  .. S RFCFPMDT=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",3.05,"I")))
  1.  .. S RFDT("RFCFPM")=$$FMTE^BQIUL1($G(BQINT(9000017,DFN_",",3.1,"I")))
  1.  . I $E($$GET1^DID(9000017,2101,"","LABEL"),1)'="*" S N=0 D
  1.  .. ;S (ACTIVE("RFFPMT"),ACTIVE("RFFPBDT"),ACTIVE("RFFPEDT"))=""
  1.  .. F  S N=$O(^AUPNREP(DFN,2101,N)) Q:'N  D
  1.  ... NEW DA,IENS
  1.  ... S DA(1)=DFN,DA=N,IENS=$$IENS^DILF(.DA)
  1.  ... I $$GET1^DIQ(9000017.02101,IENS,.05,"E")'="" Q
  1.  ... S RFFPBDT=$$GET1^DIQ(9000017.02101,IENS,.02,"I") I RFFPBDT'="" S RDATA=1
  1.  ... S RFCFUPD=$$GET1^DIQ(9000017.02101,IENS,.04,"I")
  1.  ... S RFCMCMT=$$GET1^DIQ(9000017.02101,IENS,.06,"3")
  1.  ... ;S RFFPEDT=$$GET1^DIQ(9000017.02101,IENS,.03,"I") I RFFPEDT'="" S RDATA=1
  1.  ... ;I RFFPBDT="",RFFPEDT="" Q
  1.  ... ;S RFFPMT=$$GET1^DIQ(9000017.02101,IENS,.01,"E")_"("_$$FMTE^BQIUL1(RFFPBDT)_"-"_$$FMTE^BQIUL1(RFFPEDT)_")"
  1.  ... S RFCFPM=$$GET1^DIQ(9000017.02101,IENS,.01,"E")_$S(RFCMCMT'="":" ("_RFCMCMT_")",1:"")
  1.  ... S RFCFPMDT=$$FMTE^BQIUL1(RFFPBDT),RFDT("RFCFPM")=$$FMTE^BQIUL1(RFCFUPD)
  1.  I 'RDATA,AGE<10 D  Q
  1.  . S @DATA@(II)="I00010RESULT^T00080MESSAGE"_$C(30)
  1.  . S II=II+1,@DATA@(II)="-1^RPC Failed: Patient is less than 10 years of age"_$C(30)
  1.  . S II=II+1,@DATA@(II)=$C(31)
  1.  ;
  1.  I VER<2.0 D  G DONE
  1.  . S II=II+1,@DATA@(II)="DFN^Patient^"_DFN_U_U_$C(30)
  1.  . S II=II+1,@DATA@(II)="RFLMP^Last Menstrual Period (LMP)^"_RFLMP_U_RFLMPD_U_$C(30)
  1.  . S II=II+1,@DATA@(II)="RFEDCMD^EDC^"_RFEDCMD_U_RFEDCMDT_U_$C(30)
  1.  . S II=II+1,@DATA@(II)="RPHIS^Reproductive History^"_RPHIS_U_RPHISDT_U_$C(30)
  1.  . S II=II+1,@DATA@(II)="RPCON^Contraception Method^"_RPCON_U_RPCONDT_U_$C(30)
  1.  . S II=II+1,@DATA@(II)="RPCONMBG^Current Contraception Begun^"_RPCONMBG_U_$C(30)
  1.  . ;S II=II+1,@DATA@(II)="RPHIS^Reproductive History^"_RPHIS_U_RPHISDT_$C(30)
  1.  . ;S II=II+1,@DATA@(II)="RFLMP^Last Menstrual Period (LMP)^"_RFLMP_U_RFLMPD_U_$C(30)
  1.  . ;S II=II+1,@DATA@(II)="RPCON^Contraception Method^"_RPCON_U_RPCONDT_U_$C(30)
  1.  . ;S II=II+1,@DATA@(II)="RFEDCMD^EDC Method^"_RFEDCMD_U_RFEDCMDT_U_$C(30)
  1.  . ;S II=II+1,@DATA@(II)="RFEDCDT^Estimated Date of Confinement (EDC) Date^"_RFEDCDT_U_RFEDCMDT_U_$C(30)
  1.  ;
  1.  D RDES
  1.  D:$D(ACTIVE) ACTIVATE(.ACTIVE)
  1.  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)
  1.  ;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)
  1.  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)
  1.  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)
  1.  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)
  1.  ;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)
  1.  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)
  1.  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)
  1.  ;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)
  1.  ;
  1. DONE ;
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. RDES ; Load report descriptions
  1.  S RDES("DFN")="Patient"
  1.  S RDES("RFLMP")="Last Menstrual Period (LMP)"
  1.  S RDES("RFGRAV")="Total Number of Pregnancies"
  1.  S RDES("RFPARI")="Multiple Births"
  1.  S RDES("RFFTB")="Full Term Births"
  1.  S RDES("RFPTB")="Premature Births"
  1.  S RDES("RFECTPG")="Ectopic Pregnancies"
  1.  S RDES("RFTABOR")="Abortions, Induced"
  1.  S RDES("RFSPBOR")="Abortions, Spontaneous"
  1.  S RDES("RFLIVC")="Living Children"
  1.  S RDES("RFCPREG")="Current Pregnancy Status"
  1.  ;S RDES("RFPRDT")="Pregnancy Status ""as of"" date"
  1.  S RDES("RFLACT")="Lactation Status"
  1.  S RDES("RFEDCDT")="Estimated Due Date"
  1.  S RDES("RFEDCMD")="EDD Method"
  1.  S RDES("RFAMENS")="Age at First Menses"
  1.  S RDES("RFAMENP")="Age at Menopause Onset"
  1.  S RDES("RFDESDS")="DES Daughter Status"
  1.  S RDES("RFCFPM")="Current Contraception Method"
  1.  S RDES("RFCFPMDT")="Current Contraception Begun"
  1.  S RDES("RFCOIT")="Age at first sexual intercouse"
  1.  S RDES("RFMULPRT")="Multiple Sexual Partners?"
  1.  S RDES("RFSXTRMA")="History of Sexual Trauma?"
  1.  S RDES("RFEDDDT")="Definitive EDD"
  1.  Q
  1.  ;
  1. ACTIVATE(ACTIVE) ;
  1.  ; ACTIVE = array of CODE name references to make active at 90506.31,.11
  1.  ; each element in the array maps to the CODE defined at 90506.31,.07
  1.  ; logic activates the fields in DISPLAY COLUMNS subfile of the ICARE FILE DEFINITION 
  1.  ; for the REPRODUCTIVE FACTORS entry including the FAMILY PLANNING METHOD subfile entry of REPRODUCTIVE FACTORS
  1.  N RFCODE,VDEFILE,VDEFDA,RFCDDA,VDEFIENS,DA
  1.  S (VDEFDA,RFCDDA)=0,RFCODE=""
  1.  F VDEFILE="9000017","9000017.02101" D
  1.  . S VDEFDA=$O(^BQI(90506.3,"C",VDEFILE,"")) Q:'VDEFDA
  1.  . S DA(1)=VDEFDA
  1.  . F  S RFCODE=$O(ACTIVE(RFCODE)) Q:RFCODE=""  D
  1.  .. S RFCDDA=+$O(^BQI(90506.3,VDEFDA,10,"AC",RFCODE,"")) Q:'RFCDDA
  1.  .. S DA=RFCDDA,VDEFIENS=$$IENS^DILF(.DA)
  1.  .. ;S BQINEW(90506.31,VDEFIENS,.11)=$S($G(ACTIVE):"@",1:1)
  1.  .. S BQINEW(90506.31,VDEFIENS,.11)="@"
  1.  .. K ACTIVE(RFCODE)
  1.  . F  S RFCODE=$O(INACTIVE(RFCODE)) Q:RFCODE=""  D
  1.  .. S RFCDDA=+$O(^BQI(90506.3,VDEFDA,10,"AC",RFCODE,"")) Q:'RFCDDA
  1.  .. S DA=RFCDDA,VDEFIENS=$$IENS^DILF(.DA)
  1.  .. S BQINEW(90506.31,VDEFIENS,.11)=1
  1.  .. K INACTIVE(RFCODE)
  1.  D FILE^DIE("","BQINEW","ERROR")
  1.  Q
  1.  ; 
  1. ERR ;
  1.  D ^%ZTER
  1.  NEW Y,ERRDTM
  1.  S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
  1.  S BMXSEC="Recording that an error occurred at "_ERRDTM
  1.  I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
  1.  Q