BQIPTPRV ;APTIV/HC/ALA-Add/Edit Designated Providers ; 07 Feb 2008 11:24 AM
;;2.5;ICARE MANAGEMENT SYSTEM;**1**;May 24, 2016;Build 17
;
UPD(DATA,DFN,PROV,PRCAT,PARMS) ;EP - BQI UPDATE DESIGNATED PROVIDER
; Input
; DFN - Patient IEN
; PROV - Provider IEN (if deleting, should be an '@'
; PRCAT - Provider category name
; PARMS - Parameters (NAME=VALUE)
;
NEW UID,II,RESULT,BDPLINKI
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIPTPRV",UID))
S PROV=$G(PROV,"") I PROV="" S PROV="@"
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTPRV D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S @DATA@(II)="I00010RESULT^T00100MSG"_$C(30)
;
;I PRCAT?.N S PRCAT=$$GET1^DIQ(90360.3,PRCAT_",",.01,"E")
;
; Call to provided API in DSPM package
S BDPLINKI=1
I PROV'="@" D AEDAP^BDPAPI(DFN,"@",PRCAT,.RESULT)
D AEDAP^BDPAPI(DFN,PROV,PRCAT,.RESULT)
I $P(RESULT,U,1)=0 S $P(RESULT,U,1)=-1
S II=II+1,@DATA@(II)=$P(RESULT,U,1)_U_$P(RESULT,U,2)_$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
;
BTCH(DATA,PROV,PRCAT,PLIST) ;EP - BQI BATCH UPDATE PROVIDER
NEW UID,II,RESULT,BDPLINKI
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIPTBPR",UID))
S PROV=$G(PROV,"") I PROV="" S PROV="@"
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTPRV D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S @DATA@(II)="I00010RESULT^T00100MSG"_$C(30)
S RESULT=1
; If a list of DFNs, process them instead of entire panel
I $D(PLIST)>0 D
. I $D(PLIST)>1 D
.. S LIST="",BN=""
.. F S BN=$O(PLIST(BN)) Q:BN="" S LIST=LIST_PLIST(BN)
.. K PLIST S PLIST=LIST
. ;
. F BQI=1:1 S DFN=$P(PLIST,$C(28),BQI) Q:DFN="" D
.. ; Call to provided API in DSPM package
.. S BDPLINKI=1
.. I PROV="@" D AEDAP^BDPAPI(DFN,"@",PRCAT,.RESULT)
.. I PROV'="" D AEDAP^BDPAPI(DFN,PROV,PRCAT,.RESULT)
.. I $P(RESULT,U,1)=0 S $P(RESULT,U,1)=-1
;
S II=II+1,@DATA@(II)=$P(RESULT,U,1)_U_$P(RESULT,U,2)_$C(30)
;
DNE ;
S II=II+1,@DATA@(II)=$C(31)
Q
BQIPTPRV ;APTIV/HC/ALA-Add/Edit Designated Providers ; 07 Feb 2008 11:24 AM
+1 ;;2.5;ICARE MANAGEMENT SYSTEM;**1**;May 24, 2016;Build 17
+2 ;
UPD(DATA,DFN,PROV,PRCAT,PARMS) ;EP - BQI UPDATE DESIGNATED PROVIDER
+1 ; Input
+2 ; DFN - Patient IEN
+3 ; PROV - Provider IEN (if deleting, should be an '@'
+4 ; PRCAT - Provider category name
+5 ; PARMS - Parameters (NAME=VALUE)
+6 ;
+7 NEW UID,II,RESULT,BDPLINKI
+8 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+9 SET DATA=$NAME(^TMP("BQIPTPRV",UID))
+10 SET PROV=$GET(PROV,"")
IF PROV=""
SET PROV="@"
+11 KILL @DATA
+12 ;
+13 SET II=0
+14 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIPTPRV D UNWIND^%ZTER"
+15 ;
+16 SET @DATA@(II)="I00010RESULT^T00100MSG"_$CHAR(30)
+17 ;
+18 ;I PRCAT?.N S PRCAT=$$GET1^DIQ(90360.3,PRCAT_",",.01,"E")
+19 ;
+20 ; Call to provided API in DSPM package
+21 SET BDPLINKI=1
+22 IF PROV'="@"
DO AEDAP^BDPAPI(DFN,"@",PRCAT,.RESULT)
+23 DO AEDAP^BDPAPI(DFN,PROV,PRCAT,.RESULT)
+24 IF $PIECE(RESULT,U,1)=0
SET $PIECE(RESULT,U,1)=-1
+25 SET II=II+1
SET @DATA@(II)=$PIECE(RESULT,U,1)_U_$PIECE(RESULT,U,2)_$CHAR(30)
+26 ;
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
+7 ;
BTCH(DATA,PROV,PRCAT,PLIST) ;EP - BQI BATCH UPDATE PROVIDER
+1 NEW UID,II,RESULT,BDPLINKI
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BQIPTBPR",UID))
+4 SET PROV=$GET(PROV,"")
IF PROV=""
SET PROV="@"
+5 KILL @DATA
+6 ;
+7 SET II=0
+8 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIPTPRV D UNWIND^%ZTER"
+9 ;
+10 SET @DATA@(II)="I00010RESULT^T00100MSG"_$CHAR(30)
+11 SET RESULT=1
+12 ; If a list of DFNs, process them instead of entire panel
+13 IF $DATA(PLIST)>0
Begin DoDot:1
+14 IF $DATA(PLIST)>1
Begin DoDot:2
+15 SET LIST=""
SET BN=""
+16 FOR
SET BN=$ORDER(PLIST(BN))
IF BN=""
QUIT
SET LIST=LIST_PLIST(BN)
+17 KILL PLIST
SET PLIST=LIST
End DoDot:2
+18 ;
+19 FOR BQI=1:1
SET DFN=$PIECE(PLIST,$CHAR(28),BQI)
IF DFN=""
QUIT
Begin DoDot:2
+20 ; Call to provided API in DSPM package
+21 SET BDPLINKI=1
+22 IF PROV="@"
DO AEDAP^BDPAPI(DFN,"@",PRCAT,.RESULT)
+23 IF PROV'=""
DO AEDAP^BDPAPI(DFN,PROV,PRCAT,.RESULT)
+24 IF $PIECE(RESULT,U,1)=0
SET $PIECE(RESULT,U,1)=-1
End DoDot:2
End DoDot:1
+25 ;
+26 SET II=II+1
SET @DATA@(II)=$PIECE(RESULT,U,1)_U_$PIECE(RESULT,U,2)_$CHAR(30)
+27 ;
DNE ;
+1 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+2 QUIT
