- 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