BQIIPCLN ;GDIT/HS/ALA-IPC Primary Clinics ; 07 Nov 2011 12:36 PM
;;2.3;ICARE MANAGEMENT SYSTEM;;Apr 18, 2012;Build 59
;
;
EN(DATA,FAKE) ; EP -- BQI GET IPC CLINICS
NEW UID,II,EM
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIIPCLN",UID))
K @DATA
S II=0,TYPE=$G(TYPE,"")
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIIPCLN D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S HDR="I00010IEN^T00050"
S @DATA@(II)=HDR_$C(30)
S CL=0
F S CL=$O(^BQI(90508,1,23,CL)) Q:'CL D
. S CLN=$P(^BQI(90508,1,23,CL,0),U,1)
. S II=II+1,@DATA@(II)=CLN_U_$P($G(^DIC(40.7,CLN,0)),U,1)_$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
;
UPD(DATA,PLIST) ; EP -- BQI UPDATE IPC CLINICS
;
NEW RESULT,ERROR,LIST,BN,BQ,PDATA,NAME,VALUE,BI,BQIUPD,CLN
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIUIPCL",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIIPCLN D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
S @DATA@(II)="I00010RESULT^T01024ERROR"_$C(30)
;
NEW DA,DIK
S DA(1)=1,DIK="^BQI(90508,"_DA(1)_",23,",DA=0
F S DA=$O(^BQI(90508,DA(1),23,DA)) Q:'DA D ^DIK
;
S PLIST=$G(PLIST,"")
I PLIST="" D
. S LIST="",BN=""
. F S BN=$O(PLIST(BN)) Q:BN="" S LIST=LIST_PLIST(BN)
. K PLIST
. S PLIST=LIST
. K LIST
;
S RESULT=1
F BQ=1:1:$L(PLIST,$C(29)) D Q:$G(BMXSEC)'=""
. S CLN=$P(PLIST,$C(29),BQ) Q:CLN=""
. S DA=$O(^BQI(90508,0))
. I $G(^BQI(90508,DA,23,0))="" S ^BQI(90508,DA,23,0)="^90508.023P^^"
. S DA(1)=DA,DIC(0)="LNZ",DLAYGO=90508.023,DIC="^BQI(90508,"_DA(1)_",23,"
. S X=CLN I X="" Q
. K DO,DD D FILE^DICN
. I Y=-1 S RESULT=-1
;
S II=II+1,@DATA@(II)=RESULT_U_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
BQIIPCLN ;GDIT/HS/ALA-IPC Primary Clinics ; 07 Nov 2011 12:36 PM
+1 ;;2.3;ICARE MANAGEMENT SYSTEM;;Apr 18, 2012;Build 59
+2 ;
+3 ;
EN(DATA,FAKE) ; EP -- BQI GET IPC CLINICS
+1 NEW UID,II,EM
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BQIIPCLN",UID))
+4 KILL @DATA
+5 SET II=0
SET TYPE=$GET(TYPE,"")
+6 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIIPCLN D UNWIND^%ZTER"
+7 ;
+8 SET HDR="I00010IEN^T00050"
+9 SET @DATA@(II)=HDR_$CHAR(30)
+10 SET CL=0
+11 FOR
SET CL=$ORDER(^BQI(90508,1,23,CL))
IF 'CL
QUIT
Begin DoDot:1
+12 SET CLN=$PIECE(^BQI(90508,1,23,CL,0),U,1)
+13 SET II=II+1
SET @DATA@(II)=CLN_U_$PIECE($GET(^DIC(40.7,CLN,0)),U,1)_$CHAR(30)
End DoDot:1
+14 ;
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 ;
UPD(DATA,PLIST) ; EP -- BQI UPDATE IPC CLINICS
+1 ;
+2 NEW RESULT,ERROR,LIST,BN,BQ,PDATA,NAME,VALUE,BI,BQIUPD,CLN
+3 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+4 SET DATA=$NAME(^TMP("BQIUIPCL",UID))
+5 KILL @DATA
+6 ;
+7 SET II=0
+8 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIIPCLN D UNWIND^%ZTER"
+9 SET @DATA@(II)="I00010RESULT^T01024ERROR"_$CHAR(30)
+10 ;
+11 NEW DA,DIK
+12 SET DA(1)=1
SET DIK="^BQI(90508,"_DA(1)_",23,"
SET DA=0
+13 FOR
SET DA=$ORDER(^BQI(90508,DA(1),23,DA))
IF 'DA
QUIT
DO ^DIK
+14 ;
+15 SET PLIST=$GET(PLIST,"")
+16 IF PLIST=""
Begin DoDot:1
+17 SET LIST=""
SET BN=""
+18 FOR
SET BN=$ORDER(PLIST(BN))
IF BN=""
QUIT
SET LIST=LIST_PLIST(BN)
+19 KILL PLIST
+20 SET PLIST=LIST
+21 KILL LIST
End DoDot:1
+22 ;
+23 SET RESULT=1
+24 FOR BQ=1:1:$LENGTH(PLIST,$CHAR(29))
Begin DoDot:1
+25 SET CLN=$PIECE(PLIST,$CHAR(29),BQ)
IF CLN=""
QUIT
+26 SET DA=$ORDER(^BQI(90508,0))
+27 IF $GET(^BQI(90508,DA,23,0))=""
SET ^BQI(90508,DA,23,0)="^90508.023P^^"
+28 SET DA(1)=DA
SET DIC(0)="LNZ"
SET DLAYGO=90508.023
SET DIC="^BQI(90508,"_DA(1)_",23,"
+29 SET X=CLN
IF X=""
QUIT
+30 KILL DO,DD
DO FILE^DICN
+31 IF Y=-1
SET RESULT=-1
End DoDot:1
IF $GET(BMXSEC)'=""
QUIT
+32 ;
+33 SET II=II+1
SET @DATA@(II)=RESULT_U_$CHAR(30)
+34 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+35 QUIT
