BJPNPEDT ;GDIT/HS/BEE-Prenatal Care Module PIP Edit Calls ; 08 May 2012 12:00 PM
;;2.0;PRENATAL CARE MODULE;**7**;Feb 24, 2015;Build 53
;
Q
;
SSET(DATA,PRBIEN,STAT) ;EP - BJPN SET IPL STATUS
;
;Update the IPL status from the PIP
;
NEW UID,II,TMP,STAT2,IPLUPD,ERROR,CLASS,VAPR,DFN,RESULT
;
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BJPNPEDT",UID))
K @DATA
I $G(DT)=""!($G(U)="") D DT^DICRW
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BJPNPEDT D UNWIND^%ZTER" ; SAC 2009 2.2.3.17
;
S @DATA@(II)="T00001RESULT^T00100ERROR_MESSAGE"_$C(30)
;
;Input validation
I $G(PRBIEN)="" S II=II+1,@DATA@(II)="-1^MISSING PRBIEN"_$C(30) G XSSET
I $G(STAT)="" S II=II+1,@DATA@(II)="-1^MISSING STATUS"_$C(30) G XSSET
;
S DFN=$$GET1^DIQ(9000011,PRBIEN_",",.02,"I")
;
;Reset CLASS value and handle personal history
S CLASS="@"
I STAT="Personal History" S CLASS="P",STAT="Inactive"
;
S STAT2=$S(STAT="Chronic":"A",STAT="Inactive":"I",STAT="Sub-acute":"S",STAT="Episodic":"E",STAT="Social/Environmental":"O",STAT="Routine/Admin":"R",STAT="Admin":"R",1:"E")
S VAPR=$S(STAT2="A":"C",STAT2="S":"C",STAT2="O":"C",STAT2="E":"A",1:"@")
S IPLUPD(9000011,PRBIEN_",",.14)=DUZ
S IPLUPD(9000011,PRBIEN_",",.03)=$$NOW^XLFDT
S IPLUPD(9000011,PRBIEN_",",.12)=STAT2
S IPLUPD(9000011,PRBIEN_",",.04)=CLASS
S IPLUPD(9000011,PRBIEN_",",1.14)=VAPR
D FILE^DIE("","IPLUPD","ERROR")
;
S RESULT="1^"
I $D(ERROR) S RESULT="0^Unable to update IPL status"
S II=II+1,@DATA@(II)=RESULT_$C(30)
;
;Broadcast update
D FIREEV^BJPNPDET("","PCC."_DFN_".PIP")
;
XSSET S II=II+1,@DATA@(II)=$C(31)
Q
;
DSET(DATA,PRBIEN,ONSDT) ;EP - BJPN SET DATE OF ONSET
;
;Update the IPL date of onset from the PIP
;
NEW UID,II,TMP,IPLUPD,ERROR,DFN
;
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BJPNPEDT",UID))
K @DATA
I $G(DT)=""!($G(U)="") D DT^DICRW
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BJPNPEDT D UNWIND^%ZTER" ; SAC 2009 2.2.3.17
;
S @DATA@(II)="T00001RESULT^T00100ERROR_MESSAGE"_$C(30)
;
;Input validation
I $G(PRBIEN)="" S II=II+1,@DATA@(II)="-1^MISSING PRBIEN"_$C(30) G XDSET
;
S DFN=$$GET1^DIQ(9000011,PRBIEN_",",.02,"I")
;
;Convert the Date of Onset to internal
I ONSDT]"" D S ONSDT=$$CVTDATE^BGOUTL(ONSDT)
. NEW MONTH
. I ONSDT?4N S ONSDT="3"_$E(ONSDT,3,4)_"0000" Q ;Year only
. I $L(ONSDT,"/")=2 D Q ;Month and Year
.. S:$L($P(ONSDT,"/"))=1 ONSDT="0"_ONSDT
.. S ONSDT="3"_$E($P(ONSDT,"/",2),3,4)_$P(ONSDT,"/")_"00" Q ;Month/Year
. S:ONSDT]"" ONSDT=$$DATE^BJPNPRUT($P(ONSDT," "))
S:ONSDT="" ONSDT="@"
;
S IPLUPD(9000011,PRBIEN_",",.14)=DUZ
S IPLUPD(9000011,PRBIEN_",",.03)=$$NOW^XLFDT
S IPLUPD(9000011,PRBIEN_",",.13)=ONSDT
D FILE^DIE("","IPLUPD","ERROR")
;
S RESULT="1^"
I $D(ERROR) S RESULT="0^Unable to update IPL Date of Onset"
S II=II+1,@DATA@(II)=RESULT_$C(30)
;
;Broadcast update
D FIREEV^BJPNPDET("","PCC."_DFN_".PIP")
;
XDSET S II=II+1,@DATA@(II)=$C(31)
Q
;
ERR ;
D ^%ZTER
NEW Y,ERRDTM
S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
S II=II+1,@DATA@(II)=$C(31)
Q
BJPNPEDT ;GDIT/HS/BEE-Prenatal Care Module PIP Edit Calls ; 08 May 2012 12:00 PM
+1 ;;2.0;PRENATAL CARE MODULE;**7**;Feb 24, 2015;Build 53
+2 ;
+3 QUIT
+4 ;
SSET(DATA,PRBIEN,STAT) ;EP - BJPN SET IPL STATUS
+1 ;
+2 ;Update the IPL status from the PIP
+3 ;
+4 NEW UID,II,TMP,STAT2,IPLUPD,ERROR,CLASS,VAPR,DFN,RESULT
+5 ;
+6 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+7 SET DATA=$NAME(^TMP("BJPNPEDT",UID))
+8 KILL @DATA
+9 IF $GET(DT)=""!($GET(U)="")
DO DT^DICRW
+10 ;
+11 SET II=0
+12 ; SAC 2009 2.2.3.17
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BJPNPEDT D UNWIND^%ZTER"
+13 ;
+14 SET @DATA@(II)="T00001RESULT^T00100ERROR_MESSAGE"_$CHAR(30)
+15 ;
+16 ;Input validation
+17 IF $GET(PRBIEN)=""
SET II=II+1
SET @DATA@(II)="-1^MISSING PRBIEN"_$CHAR(30)
GOTO XSSET
+18 IF $GET(STAT)=""
SET II=II+1
SET @DATA@(II)="-1^MISSING STATUS"_$CHAR(30)
GOTO XSSET
+19 ;
+20 SET DFN=$$GET1^DIQ(9000011,PRBIEN_",",.02,"I")
+21 ;
+22 ;Reset CLASS value and handle personal history
+23 SET CLASS="@"
+24 IF STAT="Personal History"
SET CLASS="P"
SET STAT="Inactive"
+25 ;
+26 SET STAT2=$SELECT(STAT="Chronic":"A",STAT="Inactive":"I",STAT="Sub-acute":"S",STAT="Episodic":"E",STAT="Social/Environmental":"O",STAT="Routine/Admin":"R",STAT="Admin":"R",1:"E")
+27 SET VAPR=$SELECT(STAT2="A":"C",STAT2="S":"C",STAT2="O":"C",STAT2="E":"A",1:"@")
+28 SET IPLUPD(9000011,PRBIEN_",",.14)=DUZ
+29 SET IPLUPD(9000011,PRBIEN_",",.03)=$$NOW^XLFDT
+30 SET IPLUPD(9000011,PRBIEN_",",.12)=STAT2
+31 SET IPLUPD(9000011,PRBIEN_",",.04)=CLASS
+32 SET IPLUPD(9000011,PRBIEN_",",1.14)=VAPR
+33 DO FILE^DIE("","IPLUPD","ERROR")
+34 ;
+35 SET RESULT="1^"
+36 IF $DATA(ERROR)
SET RESULT="0^Unable to update IPL status"
+37 SET II=II+1
SET @DATA@(II)=RESULT_$CHAR(30)
+38 ;
+39 ;Broadcast update
+40 DO FIREEV^BJPNPDET("","PCC."_DFN_".PIP")
+41 ;
XSSET SET II=II+1
SET @DATA@(II)=$CHAR(31)
+1 QUIT
+2 ;
DSET(DATA,PRBIEN,ONSDT) ;EP - BJPN SET DATE OF ONSET
+1 ;
+2 ;Update the IPL date of onset from the PIP
+3 ;
+4 NEW UID,II,TMP,IPLUPD,ERROR,DFN
+5 ;
+6 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+7 SET DATA=$NAME(^TMP("BJPNPEDT",UID))
+8 KILL @DATA
+9 IF $GET(DT)=""!($GET(U)="")
DO DT^DICRW
+10 ;
+11 SET II=0
+12 ; SAC 2009 2.2.3.17
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BJPNPEDT D UNWIND^%ZTER"
+13 ;
+14 SET @DATA@(II)="T00001RESULT^T00100ERROR_MESSAGE"_$CHAR(30)
+15 ;
+16 ;Input validation
+17 IF $GET(PRBIEN)=""
SET II=II+1
SET @DATA@(II)="-1^MISSING PRBIEN"_$CHAR(30)
GOTO XDSET
+18 ;
+19 SET DFN=$$GET1^DIQ(9000011,PRBIEN_",",.02,"I")
+20 ;
+21 ;Convert the Date of Onset to internal
+22 IF ONSDT]""
Begin DoDot:1
+23 NEW MONTH
+24 ;Year only
IF ONSDT?4N
SET ONSDT="3"_$EXTRACT(ONSDT,3,4)_"0000"
QUIT
+25 ;Month and Year
IF $LENGTH(ONSDT,"/")=2
Begin DoDot:2
+26 IF $LENGTH($PIECE(ONSDT,"/"))=1
SET ONSDT="0"_ONSDT
+27 ;Month/Year
SET ONSDT="3"_$EXTRACT($PIECE(ONSDT,"/",2),3,4)_$PIECE(ONSDT,"/")_"00"
QUIT
End DoDot:2
QUIT
+28 IF ONSDT]""
SET ONSDT=$$DATE^BJPNPRUT($PIECE(ONSDT," "))
End DoDot:1
SET ONSDT=$$CVTDATE^BGOUTL(ONSDT)
+29 IF ONSDT=""
SET ONSDT="@"
+30 ;
+31 SET IPLUPD(9000011,PRBIEN_",",.14)=DUZ
+32 SET IPLUPD(9000011,PRBIEN_",",.03)=$$NOW^XLFDT
+33 SET IPLUPD(9000011,PRBIEN_",",.13)=ONSDT
+34 DO FILE^DIE("","IPLUPD","ERROR")
+35 ;
+36 SET RESULT="1^"
+37 IF $DATA(ERROR)
SET RESULT="0^Unable to update IPL Date of Onset"
+38 SET II=II+1
SET @DATA@(II)=RESULT_$CHAR(30)
+39 ;
+40 ;Broadcast update
+41 DO FIREEV^BJPNPDET("","PCC."_DFN_".PIP")
+42 ;
XDSET SET II=II+1
SET @DATA@(II)=$CHAR(31)
+1 QUIT
+2 ;
ERR ;
+1 DO ^%ZTER
+2 NEW Y,ERRDTM
+3 SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET ERRDTM=Y
+4 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+5 QUIT
