- 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
