BJPNPEDT.m

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