BJPNAPIS.m

BJPNAPIS ;GDIT/HS/BEE-Prenatal Care Module API Call - Set PIP Problem ; 08 May 2012  12:00 PM

 ;;2.0;PRENATAL CARE MODULE;**7**;Feb 24, 2015;Build 53

 ;

 Q

 ;

SET(PRBIEN) ;PEP - Set IPL problem to PIP

 ;

 NEW RET,DFN,B,BMXSEC

 ;

 ;Validate input

 I '+$G(PRBIEN) Q "-1^PIP problem set failed - no problem IEN passed in"

 I '$D(^AUPNPROB(PRBIEN,0)) Q "-1^PIP problem set failed - invalid problem IEN"

 ;

 ;Retrieve patient DFN

 S DFN=$$GET1^DIQ(9000011,PRBIEN_",",.02,"I") I '+DFN Q "-1^PIP problem set failed - invalid DFN in problem"

 ;

 ;Set up the 'B' PIP entry

 S B="B"_U_"A"_U_"C"_U_U_$$GET1^DIQ(9000017,DFN_",",1311,"I")

 ;

 ;Update the IPL PIP column

 D

 . NEW PRBUPD,ERROR,PIP

 . S PIP=$$GET1^DIQ(9000011,PRBIEN_",",.19,"I")

 . I PIP=$S($P(B,U,2)="A":1,1:"") Q   ;Skip if already the same value

 . S PRBUPD(9000011,PRBIEN_",",".19")=$S($P(B,U,2)="A":1,1:"@")

 . D FILE^DIE("","PRBUPD","ERROR")

 ;

 ;Make the call to create the PIP entry

 S RET=$$ADDPIP^BJPNPSET(DFN,PRBIEN,B)

 ;

 ;Handle failure

 I RET=-1 Q "-1"_U_$G(BMXSEC)

 ;

 Q ""

 ;

ERR      ;

 D ^%ZTER

 NEW Y,ERRDTM

 S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y

 Q

BJPNAPIS  ;GDIT/HS/BEE-Prenatal Care Module API Call - Set PIP Problem ; 08 May 2012  12:00 PM

 +1       ;;2.0;PRENATAL CARE MODULE;**7**;Feb 24, 2015;Build 53

 +2       ;

 +3        QUIT 

 +4       ;

SET(PRBIEN) ;PEP - Set IPL problem to PIP

 +1       ;

 +2        NEW RET,DFN,B,BMXSEC

 +3       ;

 +4       ;Validate input

 +5        IF '+$GET(PRBIEN)

               QUIT "-1^PIP problem set failed - no problem IEN passed in"

 +6        IF '$DATA(^AUPNPROB(PRBIEN,0))

               QUIT "-1^PIP problem set failed - invalid problem IEN"

 +7       ;

 +8       ;Retrieve patient DFN

 +9        SET DFN=$$GET1^DIQ(9000011,PRBIEN_",",.02,"I")

           IF '+DFN

               QUIT "-1^PIP problem set failed - invalid DFN in problem"

 +10      ;

 +11      ;Set up the 'B' PIP entry

 +12       SET B="B"_U_"A"_U_"C"_U_U_$$GET1^DIQ(9000017,DFN_",",1311,"I")

 +13      ;

 +14      ;Update the IPL PIP column

 +15       Begin DoDot:1

 +16           NEW PRBUPD,ERROR,PIP

 +17           SET PIP=$$GET1^DIQ(9000011,PRBIEN_",",.19,"I")

 +18      ;Skip if already the same value

               IF PIP=$SELECT($PIECE(B,U,2)="A":1,1:"")

                   QUIT 

 +19           SET PRBUPD(9000011,PRBIEN_",",".19")=$SELECT($PIECE(B,U,2)="A":1,1:"@")

 +20           DO FILE^DIE("","PRBUPD","ERROR")

           End DoDot:1

 +21      ;

 +22      ;Make the call to create the PIP entry

 +23       SET RET=$$ADDPIP^BJPNPSET(DFN,PRBIEN,B)

 +24      ;

 +25      ;Handle failure

 +26       IF RET=-1

               QUIT "-1"_U_$GET(BMXSEC)

 +27      ;

 +28       QUIT ""

 +29      ;

ERR       ;

 +1        DO ^%ZTER

 +2        NEW Y,ERRDTM

 +3        SET Y=$$NOW^XLFDT()

           XECUTE ^DD("DD")

           SET ERRDTM=Y

 +4        QUIT