BQIIPPOR.m

BQIIPPOR ;VNGT/HS/ALA-IPC Portal ; 22 Sep 2011  3:09 PM

 ;;2.3;ICARE MANAGEMENT SYSTEM;;Apr 18, 2012;Build 59

 ;

 ;

EN(DATA,FAKE) ;EP -- BQI GET IPC PORTAL

 NEW UID,II,HDR,PROD,CRIPC,CRN,IP,DOWN,UP

 S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)

 S DATA=$NA(^TMP("BQIIPPOR",UID)) K @DATA

 ;

 S II=0

 NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIIPPOR D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2

 ;

 S HDR="T00120PORTAL_IP_DOWNLOAD^T00120PORTAL_IP_UPLOAD"

 S @DATA@(II)=HDR_$C(30)

 ;

 S PROD=$$PROD^XUPROD()

 ; Get current IPC

 S CRIPC=$P($G(^BQI(90508,1,11)),U,1)

 S CRN=$O(^BQI(90508,1,22,"B",CRIPC,"")) I CRN="" Q

 I 'PROD S DOWN=$P($G(^BQI(90508,1,22,CRN,4)),U,1),UP=$P($G(^BQI(90508,1,22,CRN,4)),U,2)

 I PROD S DOWN=$P($G(^BQI(90508,1,22,CRN,5)),U,1),UP=$P($G(^BQI(90508,1,22,CRN,5)),U,2)

 S II=II+1,@DATA@(II)=DOWN_U_UP_$C(30)

DONE ;

 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 BMXSEC="Recording that an error occurred at "_ERRDTM

 I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)

 Q

BQIIPPOR  ;VNGT/HS/ALA-IPC Portal ; 22 Sep 2011  3:09 PM

 +1       ;;2.3;ICARE MANAGEMENT SYSTEM;;Apr 18, 2012;Build 59

 +2       ;

 +3       ;

EN(DATA,FAKE) ;EP -- BQI GET IPC PORTAL

 +1        NEW UID,II,HDR,PROD,CRIPC,CRN,IP,DOWN,UP

 +2        SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

 +3        SET DATA=$NAME(^TMP("BQIIPPOR",UID))

           KILL @DATA

 +4       ;

 +5        SET II=0

 +6       ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

           SET $ETRAP="D ERR^BQIIPPOR D UNWIND^%ZTER"

 +7       ;

 +8        SET HDR="T00120PORTAL_IP_DOWNLOAD^T00120PORTAL_IP_UPLOAD"

 +9        SET @DATA@(II)=HDR_$CHAR(30)

 +10      ;

 +11       SET PROD=$$PROD^XUPROD()

 +12      ; Get current IPC

 +13       SET CRIPC=$PIECE($GET(^BQI(90508,1,11)),U,1)

 +14       SET CRN=$ORDER(^BQI(90508,1,22,"B",CRIPC,""))

           IF CRN=""

               QUIT 

 +15       IF 'PROD

               SET DOWN=$PIECE($GET(^BQI(90508,1,22,CRN,4)),U,1)

               SET UP=$PIECE($GET(^BQI(90508,1,22,CRN,4)),U,2)

 +16       IF PROD

               SET DOWN=$PIECE($GET(^BQI(90508,1,22,CRN,5)),U,1)

               SET UP=$PIECE($GET(^BQI(90508,1,22,CRN,5)),U,2)

 +17       SET II=II+1

           SET @DATA@(II)=DOWN_U_UP_$CHAR(30)

DONE      ;

 +1        SET II=II+1

           SET @DATA@(II)=$CHAR(31)

 +2        QUIT 

 +3       ;

ERR       ;

 +1        DO ^%ZTER

 +2        NEW Y,ERRDTM

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

           XECUTE ^DD("DD")

           SET ERRDTM=Y

 +4        SET BMXSEC="Recording that an error occurred at "_ERRDTM

 +5        IF $DATA(II)

               IF $DATA(DATA)

                   SET II=II+1

                   SET @DATA@(II)=$CHAR(31)

 +6        QUIT