AUPNREP ; IHS/CMI/LAB - REPRODUCTIVE FACTORS; ; 20 Nov 2009 9:23 AM
;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009;Build 9
;
RHX(X) ;PEP - called to return a string of reproductive history
I '$G(X) Q ""
I '$D(^AUPNREP(X)) Q ""
NEW A,B,N,G
S B=""
S N=$G(^AUPNREP(X,11))
I N="" Q ""
S (A,G)=$P(N,U,3)
S:A="" A=" " S B=B_"Total # of Pregnancies "_A
S A=$P(N,U,7)
I A=""
S:A="" A=" " S B=B_"; Full Term "_A
S B=B_" "
S A=$P(N,U,9)
S:A="" A=" " S B=B_"; Premature "_A
S A=$P(N,U,31)
S:A="" A=" " S B=B_"; Abortions, Induced "_A
S A=$P(N,U,33)
S:A="" A=" " S B=B_"; Abortions, Spontaneous "_A
S A=$P(N,U,11)
S:A="" A=" " S B=B_"; Ectopic Pregnancies "_A
S A=$P(N,U,5)
S:A="" A=" " S B=B_"; Multiple Births "_A
S A=$P(N,U,13)
S:A="" A=" " S B=B_"; Living Children "_A
Q B
;
RHXSM(X) ;PEP - called from screenman screen to populate reproductive history
I '$G(X) Q ""
NEW A,B,N,G
S B=""
S (A,G)=$$GET^DDSVAL(DIE,.DA,1103)
S:A="" A=" " S B=B_"G"_A
S A=$$GET^DDSVAL(DIE,.DA,1105)
I A="",G=0 S A=0
S:A="" A=" " S B=B_"P"_A
S B=B_" "
S A=$$GET^DDSVAL(DIE,.DA,1107)
I A="",G=0 S A=0
S:A="" A=" " S B=B_"F"_A
S A=$$GET^DDSVAL(DIE,.DA,1109)
I A="",G=0 S A=0
S:A="" A=" " S B=B_"P"_A
S A=$$GET^DDSVAL(DIE,.DA,1111)
I A="",G=0 S A=0
S:A="" A=" " S B=B_"A"_A
S A=$$GET^DDSVAL(DIE,.DA,1113)
I A="",G=0 S A=0
S:A="" A=" " S B=B_"LC"_A
Q B
;
;;
CONVRH ;EP - called from post init
NEW APCDX,APCDY,APCDZ
D EN^DDIOL("Converting Reproductive History field to individual field values","","!!")
S APCDX=0 F S APCDX=$O(^AUPNREP(APCDX)) Q:APCDX'=+APCDX D
.S APCDY=$P(^AUPNREP(APCDX,0),U,2)
.Q:APCDY=""
.I $D(^AUPNREP(APCDX,11)) Q ;already has new data fields
.S APCDZ=$$PARSERHS(APCDY)
.Q:APCDZ=""
.D ^XBFMK
.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///@"
.D ^DIE
.I $D(Y) D EN^DDIOL("Entry "_APCDX_" failed")
.D ^XBFMK
.;D EN^DDIOL(".")
.Q
Q
;
PARSERHS(%) ;EP
;return G^P^LC^SA^TA
NEW R
S R=""
S $P(R,U)=+$P(%,"G",2)
I $P(%,"P",2)]"" S $P(R,U,2)=+$P(%,"P",2)
I $P(%,"LC",2)]"" S $P(R,U,3)=+$P(%,"LC",2)
I $P(%,"SA",2)]"" S $P(R,U,4)=+$P(%,"SA",2)
I $P(%,"TA",2)]"" S $P(R,U,5)=+$P(%,"TA",2)
Q R
AUPNREP ; IHS/CMI/LAB - REPRODUCTIVE FACTORS; ; 20 Nov 2009 9:23 AM
+1 ;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009;Build 9
+2 ;
RHX(X) ;PEP - called to return a string of reproductive history
+1 IF '$GET(X)
QUIT ""
+2 IF '$DATA(^AUPNREP(X))
QUIT ""
+3 NEW A,B,N,G
+4 SET B=""
+5 SET N=$GET(^AUPNREP(X,11))
+6 IF N=""
QUIT ""
+7 SET (A,G)=$PIECE(N,U,3)
+8 IF A=""
SET A=" "
SET B=B_"Total # of Pregnancies "_A
+9 SET A=$PIECE(N,U,7)
+10 IF A=""
+11 IF A=""
SET A=" "
SET B=B_"; Full Term "_A
+12 SET B=B_" "
+13 SET A=$PIECE(N,U,9)
+14 IF A=""
SET A=" "
SET B=B_"; Premature "_A
+15 SET A=$PIECE(N,U,31)
+16 IF A=""
SET A=" "
SET B=B_"; Abortions, Induced "_A
+17 SET A=$PIECE(N,U,33)
+18 IF A=""
SET A=" "
SET B=B_"; Abortions, Spontaneous "_A
+19 SET A=$PIECE(N,U,11)
+20 IF A=""
SET A=" "
SET B=B_"; Ectopic Pregnancies "_A
+21 SET A=$PIECE(N,U,5)
+22 IF A=""
SET A=" "
SET B=B_"; Multiple Births "_A
+23 SET A=$PIECE(N,U,13)
+24 IF A=""
SET A=" "
SET B=B_"; Living Children "_A
+25 QUIT B
+26 ;
RHXSM(X) ;PEP - called from screenman screen to populate reproductive history
+1 IF '$GET(X)
QUIT ""
+2 NEW A,B,N,G
+3 SET B=""
+4 SET (A,G)=$$GET^DDSVAL(DIE,.DA,1103)
+5 IF A=""
SET A=" "
SET B=B_"G"_A
+6 SET A=$$GET^DDSVAL(DIE,.DA,1105)
+7 IF A=""
IF G=0
SET A=0
+8 IF A=""
SET A=" "
SET B=B_"P"_A
+9 SET B=B_" "
+10 SET A=$$GET^DDSVAL(DIE,.DA,1107)
+11 IF A=""
IF G=0
SET A=0
+12 IF A=""
SET A=" "
SET B=B_"F"_A
+13 SET A=$$GET^DDSVAL(DIE,.DA,1109)
+14 IF A=""
IF G=0
SET A=0
+15 IF A=""
SET A=" "
SET B=B_"P"_A
+16 SET A=$$GET^DDSVAL(DIE,.DA,1111)
+17 IF A=""
IF G=0
SET A=0
+18 IF A=""
SET A=" "
SET B=B_"A"_A
+19 SET A=$$GET^DDSVAL(DIE,.DA,1113)
+20 IF A=""
IF G=0
SET A=0
+21 IF A=""
SET A=" "
SET B=B_"LC"_A
+22 QUIT B
+23 ;
+24 ;;
CONVRH ;EP - called from post init
+1 NEW APCDX,APCDY,APCDZ
+2 DO EN^DDIOL("Converting Reproductive History field to individual field values","","!!")
+3 SET APCDX=0
FOR
SET APCDX=$ORDER(^AUPNREP(APCDX))
IF APCDX'=+APCDX
QUIT
Begin DoDot:1
+4 SET APCDY=$PIECE(^AUPNREP(APCDX,0),U,2)
+5 IF APCDY=""
QUIT
+6 ;already has new data fields
IF $DATA(^AUPNREP(APCDX,11))
QUIT
+7 SET APCDZ=$$PARSERHS(APCDY)
+8 IF APCDZ=""
QUIT
+9 DO ^XBFMK
+10 SET DIE="^AUPNREP("
SET DA=APCDX
SET DR="1103///"_$PIECE(APCDZ,U,1)_";1107///"_$PIECE(APCDZ,U,2)_";1113///"_$PIECE(APCDZ,U,3)_";1133///"_$PIECE(APCDZ,U,4)_";1131///"_$PIECE(APCDZ,U,5)_";1///@"
+11 DO ^DIE
+12 IF $DATA(Y)
DO EN^DDIOL("Entry "_APCDX_" failed")
+13 DO ^XBFMK
+14 ;D EN^DDIOL(".")
+15 QUIT
End DoDot:1
+16 QUIT
+17 ;
PARSERHS(%) ;EP
+1 ;return G^P^LC^SA^TA
+2 NEW R
+3 SET R=""
+4 SET $PIECE(R,U)=+$PIECE(%,"G",2)
+5 IF $PIECE(%,"P",2)]""
SET $PIECE(R,U,2)=+$PIECE(%,"P",2)
+6 IF $PIECE(%,"LC",2)]""
SET $PIECE(R,U,3)=+$PIECE(%,"LC",2)
+7 IF $PIECE(%,"SA",2)]""
SET $PIECE(R,U,4)=+$PIECE(%,"SA",2)
+8 IF $PIECE(%,"TA",2)]""
SET $PIECE(R,U,5)=+$PIECE(%,"TA",2)
+9 QUIT R
