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

AUPNREP.m

Go to the documentation of this file.
  1. AUPNREP ; IHS/CMI/LAB - REPRODUCTIVE FACTORS; ; 20 Nov 2009 9:23 AM
  1. ;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009;Build 9
  1. ;
  1. RHX(X) ;PEP - called to return a string of reproductive history
  1. I '$G(X) Q ""
  1. I '$D(^AUPNREP(X)) Q ""
  1. NEW A,B,N,G
  1. S B=""
  1. S N=$G(^AUPNREP(X,11))
  1. I N="" Q ""
  1. S (A,G)=$P(N,U,3)
  1. S:A="" A=" " S B=B_"Total # of Pregnancies "_A
  1. S A=$P(N,U,7)
  1. I A=""
  1. S:A="" A=" " S B=B_"; Full Term "_A
  1. S B=B_" "
  1. S A=$P(N,U,9)
  1. S:A="" A=" " S B=B_"; Premature "_A
  1. S A=$P(N,U,31)
  1. S:A="" A=" " S B=B_"; Abortions, Induced "_A
  1. S A=$P(N,U,33)
  1. S:A="" A=" " S B=B_"; Abortions, Spontaneous "_A
  1. S A=$P(N,U,11)
  1. S:A="" A=" " S B=B_"; Ectopic Pregnancies "_A
  1. S A=$P(N,U,5)
  1. S:A="" A=" " S B=B_"; Multiple Births "_A
  1. S A=$P(N,U,13)
  1. S:A="" A=" " S B=B_"; Living Children "_A
  1. Q B
  1. ;
  1. RHXSM(X) ;PEP - called from screenman screen to populate reproductive history
  1. I '$G(X) Q ""
  1. NEW A,B,N,G
  1. S B=""
  1. S (A,G)=$$GET^DDSVAL(DIE,.DA,1103)
  1. S:A="" A=" " S B=B_"G"_A
  1. S A=$$GET^DDSVAL(DIE,.DA,1105)
  1. I A="",G=0 S A=0
  1. S:A="" A=" " S B=B_"P"_A
  1. S B=B_" "
  1. S A=$$GET^DDSVAL(DIE,.DA,1107)
  1. I A="",G=0 S A=0
  1. S:A="" A=" " S B=B_"F"_A
  1. S A=$$GET^DDSVAL(DIE,.DA,1109)
  1. I A="",G=0 S A=0
  1. S:A="" A=" " S B=B_"P"_A
  1. S A=$$GET^DDSVAL(DIE,.DA,1111)
  1. I A="",G=0 S A=0
  1. S:A="" A=" " S B=B_"A"_A
  1. S A=$$GET^DDSVAL(DIE,.DA,1113)
  1. I A="",G=0 S A=0
  1. S:A="" A=" " S B=B_"LC"_A
  1. Q B
  1. ;
  1. ;;
  1. CONVRH ;EP - called from post init
  1. NEW APCDX,APCDY,APCDZ
  1. D EN^DDIOL("Converting Reproductive History field to individual field values","","!!")
  1. S APCDX=0 F S APCDX=$O(^AUPNREP(APCDX)) Q:APCDX'=+APCDX D
  1. .S APCDY=$P(^AUPNREP(APCDX,0),U,2)
  1. .Q:APCDY=""
  1. .I $D(^AUPNREP(APCDX,11)) Q ;already has new data fields
  1. .S APCDZ=$$PARSERHS(APCDY)
  1. .Q:APCDZ=""
  1. .D ^XBFMK
  1. .S DIE="^AUPNREP(",DA=APCDX,DR="1103///"_$P(APCDZ,U,1)_";1107///"_$P(APCDZ,U,2)_";1113///"_$P(APCDZ,U,3)_";1133///"_$P(APCDZ,U,4)_";1131///"_$P(APCDZ,U,5)_";1///@"
  1. .D ^DIE
  1. .I $D(Y) D EN^DDIOL("Entry "_APCDX_" failed")
  1. .D ^XBFMK
  1. .;D EN^DDIOL(".")
  1. .Q
  1. Q
  1. ;
  1. PARSERHS(%) ;EP
  1. ;return G^P^LC^SA^TA
  1. NEW R
  1. S R=""
  1. S $P(R,U)=+$P(%,"G",2)
  1. I $P(%,"P",2)]"" S $P(R,U,2)=+$P(%,"P",2)
  1. I $P(%,"LC",2)]"" S $P(R,U,3)=+$P(%,"LC",2)
  1. I $P(%,"SA",2)]"" S $P(R,U,4)=+$P(%,"SA",2)
  1. I $P(%,"TA",2)]"" S $P(R,U,5)=+$P(%,"TA",2)
  1. Q R