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

BQIRGPG.m

Go to the documentation of this file. 
  1. BQIRGPG ;GDIT/HS/ALA-Pregnancy Care Mgmt ; 17 Jul 2013  7:49 AM
  1.  ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
  1.  ;
  1. CURR(DFN) ;EP - Currently marked as pregnant
  1.  NEW RESULT
  1.  S RESULT="NO"
  1.  I $$GET1^DIQ(9000017,DFN_",",1101,"E")'="" S RESULT=$$GET1^DIQ(9000017,DFN_",",1101,"E")
  1.  Q RESULT
  1.  ;
  1. EDD(DFN) ;EP - Definitive Date of Delivery
  1.  NEW RES,ARRAY,PI,PDATA,EDD
  1.  S RES="",PDATA=$G(^AUPNREP(DFN,13))
  1.  S PI=11
  1.  I $P(PDATA,U,PI)'="" S EDD=$P(PDATA,U,PI)
  1.  I $G(EDD)'="" S RES=$$FMTE^BQIUL1(EDD)
  1.  Q RES
  1.  ;
  1. EEDD(DFN) ; EP - Estimated Date of Delivery
  1.  NEW RES,ARRAY,PI,PDATA,EDD
  1.  S RES="",PDATA=$G(^AUPNREP(DFN,13))
  1.  F PI=2,5,8,14 D
  1.  . I $P(PDATA,U,PI)'="" S ARRAY($P(PDATA,U,PI))=PI
  1.  S EDD=$O(ARRAY(""),-1) I EDD'="" S RES=$$FMTE^BQIUL1(EDD)
  1.  Q RES
  1.  ;
  1. HGH(DFN) ;EP - High Risk Prenatal Problems
  1.  NEW BQJN,OK
  1.  S OK="NO",BQJN=""
  1.  F  S BQJN=$O(^BJPNPL("D",DFN,BQJN)) Q:BQJN=""  D
  1.  . I $P(^BJPNPL(BQJN,0),U,6)="H" S OK="YES"
  1.  Q OK
  1.  ;
  1. EGA(DFN) ;EP - Estimated gestational age
  1.  NEW VALL,RES,DATE
  1.  S RES=""
  1.  S VALL=$$MEAS^BQITUTL(DFN,"EGA")
  1.  I VALL=0 Q RES
  1.  S RES=$P(VALL,U,3)_" ("_$$FMTE^BQIUL1($P(VALL,U,2))_")"
  1.  Q RES
  1.  ;
  1. GRAV(DFN) ;EP - Gravida Total # of pregnancies
  1.  NEW RES
  1.  S RES=+$$GET1^DIQ(9000017,DFN_",",1103,"E")
  1.  Q RES
  1.  ;
  1. LAB ;EP - Pull out prenatal lab tests
  1.  NEW LRES,RES
  1.  S LRES=$$ITM^BQICMUTL("",BQDFN,FREF,RREF,ITM,TAX,.TREF)
  1.  I $P(LRES,U,1)=0 S RESULT=0 Q
  1.  S RES=$P(LRES,U,7) I RES="" S RES=$P(LRES,U,6)
  1.  S RESULT=1_U_$P(LRES,U,2)_U_RES
  1.  Q
  1.  ;
  1. LBT ;EP - Set up lab tests
  1.  NEW TAX,TREF
  1.  S TAX="BQI PRENATAL TAX"
  1.  S TREF=$NA(^TMP("BQIPRENTL",$J)) K @TREF
  1.  D BLD^BQITUTL(TAX,.TREF,"L")
  1.  ; Clean up labs
  1.  NEW DA,IENS,CIEN
  1.  S CIEN=$O(^BQI(90506.5,"B","Prenatal","")) I CIEN="" Q
  1.  S DA=0,DA(1)=CIEN
  1.  F  S DA=$O(^BQI(90506.5,CIEN,10,DA)) Q:'DA  D
  1.  . S IENS=$$IENS^DILF(.DA)
  1.  . S BQIUPD(90506.51,IENS,.09)=1
  1.  I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
  1.  ;
  1.  ; Set up lab tests
  1.  NEW BN,CT,CD,DA,IENS,DIC,DESC,PNL,DLAYGO,DIC,X,Y,NM,NAME
  1.  S BN=0
  1.  F  S BN=$O(@TREF@(BN)) Q:'BN  D
  1.  . S NM=$P(^LAB(60,BN,.1),U,1),NAME=$P(^LAB(60,BN,0),"^",1)
  1.  . S PNL=0 I $O(^LAB(60,BN,2,0))'="" S PNL=1
  1.  . S IEN=$O(^BQI(90506.5,CIEN,10,"C",NM,""))
  1.  . I IEN'="" D
  1.  .. S DA(1)=CIEN,DA=IEN,IENS=$$IENS^DILF(.DA)
  1.  .. S BQIUPD(90506.51,IENS,.09)="@"
  1.  .. D FILE^DIE("","BQIUPD","ERROR")
  1.  .. I PNL S DESC(1)="Most recent "_NAME_" panel from V Lab is displayed."
  1.  .. I 'PNL S DESC(1)="Most recent "_NAME_" lab test from V Lab is displayed."
  1.  .. D WP^DIE(90506.51,IENS,4,"","DESC")
  1.  . I IEN="" D
  1.  .. S CT=$P($G(^BQI(90506.5,CIEN,10,0)),U,3),CT=CT+1
  1.  .. S CD="PG_"_$E("0000",$L(CT),2)_CT
  1.  .. S DA(1)=CIEN,X=CD,DIC="^BQI(90506.5,"_DA(1)_",10,",DIC(0)="L",DLAYGO=90506.51
  1.  .. K DO,DD D FILE^DICN S DA=+Y
  1.  .. S IENS=$$IENS^DILF(.DA)
  1.  .. S BQIUPD(90506.51,IENS,.02)=3,BQIUPD(90506.51,IENS,.03)=NM
  1.  .. S BQIUPD(90506.51,IENS,.04)=BN,BQIUPD(90506.51,IENS,.05)="B"
  1.  .. S BQIUPD(90506.51,IENS,.06)="D",BQIUPD(90506.51,IENS,.08)="A"
  1.  .. S BQIUPD(90506.51,IENS,1)="D LAB^BQIRGPG"
  1.  .. D FILE^DIE("","BQIUPD","ERROR")
  1.  .. I PNL S DESC(1)="Most recent "_NAME_" panel from V Lab is displayed."
  1.  .. I 'PNL S DESC(1)="Most recent "_NAME_" lab test from V Lab is displayed."
  1.  .. D WP^DIE(90506.51,IENS,4,"","DESC")
  1.  K @TREF
  1.  Q
  1.  ;
  1. GLS(DATA,FAKE) ;EP - BQI GET PRENATAL GLOSSARY
  1.  NEW UID,II,TRIEN,CAT,TIT,SORT,RMK,REMARK,CT,NXT,GLIEN,IEN
  1.  ;
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIRGPGLS",UID))
  1.  K @DATA
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIRGPG D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S @DATA@(II)="T32767REPORT_TEXT"_$C(30)
  1.  S GLIEN=$O(^BQI(90508.2,"B","Prenatal","")) I GLIEN="" S BMXSEC="Problem with Prenatal glossary in file 90508.2" G DONE
  1.  S IEN=0 F  S IEN=$O(^BQI(90508.2,GLIEN,1,IEN)) Q:'IEN  D
  1.  . S II=II+1,@DATA@(II)=$G(^BQI(90508.2,GLIEN,1,IEN,0))
  1.  ;S GLIEN=$O(^BQI(90506.5,"B","Prenatal","")) I GLIEN="" S BMXSEC="Problem with Prenatal source list" G DONE
  1.  ;S IEN=0 F  S IEN=$O(^BQI(90506.5,GLIEN,10,IEN)) Q:'IEN  D
  1.  ;. S IIEN=$P(^BQI(90506.5,GLIEN,10,IEN,0),U,4)
  1.  ;. S II=II+1,@DATA@(II)="    "_$P(^BQI(90506.5,GLIEN,10,IEN,0),U,3)_" ("_$P($G(^LAB(60,IIEN,0)),U,1)_")"
  1.  I II>0 S @DATA@(II)=@DATA@(II)_$C(30)
  1.  ;
  1. DONE S II=II+1,@DATA@(II)=$C(31)
  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