BQIPLAP ;PRXM/HC/ALA-Add Patients ; 11 Sep 2006 5:36 PM
;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
;
Q
;
MANP(DATA,OWNR,PLIEN,FLAG,PLIST) ; EP - BQI MANUAL ADD/REMOVE PATIENTS
;
;Description
; Manually add a patient or remove a patient from a panel
;Input
; OWNR - Owner of the panel
; PLIEN - Panel internal entry number
; FLAG - "A" for add, "R" for remove
; PLIST - List of patient IENs separated by $C(28)
;DUZ is assumed to be the user signed onto iCare.
;DFN is the Patient internal entry number
;
NEW UID,II,X,RESULT,LIST,BN
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIMANP",UID))
K ^TMP("BQIMANP",UID)
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPLAP D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
; Check if share and has write access
I DUZ'=OWNR,'$$CKSHR^BQIPLSH(OWNR,PLIEN) S BMXSEC="You do not have write access" Q
;
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
F BQI=1:1 S DFN=$P(PLIST,$C(28),BQI) Q:DFN="" D
. NEW DA,IENS
. ;Check if patient is already in panel
. I $D(^BQICARE(OWNR,1,PLIEN,40,DFN)) D
.. I $P(^BQICARE(OWNR,1,PLIEN,40,DFN,0),U,2)="A",FLAG="A" S RESULT=0 Q
.. I $P(^BQICARE(OWNR,1,PLIEN,40,DFN,0),U,2)="R",FLAG="R" S RESULT=0 Q
.. I FLAG="A" D APTM(DFN)
.. I FLAG="R" D RPTM(DFN)
. ;
. I '$D(^BQICARE(OWNR,1,PLIEN,40,DFN)),FLAG="A" D APTM(DFN)
. I '$D(^BQICARE(OWNR,1,PLIEN,40,DFN)),FLAG="R" S RESULT=0
;
S DIK(1)=".01",DA(2)=OWNR,DA(1)=PLIEN
S DIK="^BQICARE("_DA(2)_",1,"_DA(1)_",40,"
D ENALL^DIK
; Get total count of patients
D CNTP(OWNR,PLIEN)
;
NEW DA,PIENS,BQIUP
S DA(1)=OWNR,DA=PLIEN,PIENS=$$IENS^DILF(.DA)
S BQIUP(90505.01,PIENS,.09)=$$NOW^XLFDT()
S BQIUP(90505.01,PIENS,.08)=DUZ
D FILE^DIE("","BQIUP","ERROR")
;
S II=0,^TMP("BQIMANP",UID,II)="I00010RESULT"_$C(30)
S II=II+1,^TMP("BQIMANP",UID,II)=RESULT_$C(30)
S II=II+1,^TMP("BQIMANP",UID,II)=$C(31)
Q
;
APTM(DFN) ;EP - Add patient record manually
NEW DA,DATA
S DA(2)=OWNR,DA(1)=PLIEN
I '$D(^BQICARE(DA(2),1,DA(1),40,0)) S ^BQICARE(DA(2),1,DA(1),40,0)="^90505.04P^^"
; Update the user for flags for this patient
I '$D(^BQICARE(DA(2),1,"AB",DFN)) D UPU^BQIFLAG(DFN,OWNR)
; Update the patient record in panel
S DATA=DFN_U_"A"_U_DUZ_U_$$NOW^XLFDT()
S $P(DATA,U,8)=$S($$FLG^BQIULPT(DUZ,PLIEN,DFN)="Y":1,1:0)
S ^BQICARE(OWNR,1,PLIEN,40,DFN,0)=DATA
S RESULT=1
Q
;
RPTM(DFN) ;EP - Remove patient record manually
NEW DA,DATA
S DA(2)=OWNR,DA(1)=PLIEN
S DA=DFN,IENS=$$IENS^DILF(.DA)
S DATA=$G(^BQICARE(DA(2),1,DA(1),40,DFN,0))
I DATA="" S DATA=DFN
S $P(DATA,U,2)="R",$P(DATA,U,5)=DUZ,$P(DATA,U,6)=$$NOW^XLFDT(),$P(DATA,U,8)=0
S ^BQICARE(DA(2),1,DA(1),40,DFN,0)=DATA
S RESULT=1
Q
;
CNTP(OWNR,PLIEN) ;EP - Count patients and file the total
;
;Input
; OWNR - Owner of the panel
; PLIEN - Panel internal entry number
;
NEW DA,PIENS,DFN,IENS,CNT,BQIUP,SFLG
S DA(1)=OWNR,DA=PLIEN,PIENS=$$IENS^DILF(.DA)
S DFN=0,CNT=0,SFLG=0
F S DFN=$O(^BQICARE(OWNR,1,PLIEN,40,DFN)) Q:'DFN D
. S DA(2)=OWNR,DA(1)=PLIEN,DA=DFN,IENS=$$IENS^DILF(.DA)
. I $$GET1^DIQ(90505.04,IENS,.02,"I")="R" Q
. S CNT=CNT+1
. ; Check for sensitive patient
. I $$SENS^BQIULPT(DFN)="Y" S SFLG=1
. ; Set flags for patient
. D UPU^BQIFLAG(DFN,OWNR)
;
S BQIUP(90505.01,PIENS,.1)=CNT
S BQIUP(90505.01,PIENS,.07)=$$NOW^XLFDT()
S BQIUP(90505.01,PIENS,3.5)=DUZ
S BQIUP(90505.01,PIENS,3.6)=SFLG
D FILE^DIE("I","BQIUP")
;
; Count flags for panel
D CNTP^BQIFLG(OWNR,PLIEN)
Q
;
ERR ;
L -^BQICARE(OWNR,1,0)
D ^%ZTER
N Y,ERRDTM
S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
S BMXSEC="Recording that an error occurred at "_ERRDTM
Q
BQIPLAP ;PRXM/HC/ALA-Add Patients ; 11 Sep 2006 5:36 PM
+1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
+3 QUIT
+4 ;
MANP(DATA,OWNR,PLIEN,FLAG,PLIST) ; EP - BQI MANUAL ADD/REMOVE PATIENTS
+1 ;
+2 ;Description
+3 ; Manually add a patient or remove a patient from a panel
+4 ;Input
+5 ; OWNR - Owner of the panel
+6 ; PLIEN - Panel internal entry number
+7 ; FLAG - "A" for add, "R" for remove
+8 ; PLIST - List of patient IENs separated by $C(28)
+9 ;DUZ is assumed to be the user signed onto iCare.
+10 ;DFN is the Patient internal entry number
+11 ;
+12 NEW UID,II,X,RESULT,LIST,BN
+13 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+14 SET DATA=$NAME(^TMP("BQIMANP",UID))
+15 KILL ^TMP("BQIMANP",UID)
+16 ;
+17 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIPLAP D UNWIND^%ZTER"
+18 ;
+19 ; Check if share and has write access
+20 IF DUZ'=OWNR
IF '$$CKSHR^BQIPLSH(OWNR,PLIEN)
SET BMXSEC="You do not have write access"
QUIT
+21 ;
+22 SET PLIST=$GET(PLIST,"")
+23 IF PLIST=""
Begin DoDot:1
+24 SET LIST=""
SET BN=""
+25 FOR
SET BN=$ORDER(PLIST(BN))
IF BN=""
QUIT
SET LIST=LIST_PLIST(BN)
+26 KILL PLIST
+27 SET PLIST=LIST
+28 KILL LIST
End DoDot:1
+29 FOR BQI=1:1
SET DFN=$PIECE(PLIST,$CHAR(28),BQI)
IF DFN=""
QUIT
Begin DoDot:1
+30 NEW DA,IENS
+31 ;Check if patient is already in panel
+32 IF $DATA(^BQICARE(OWNR,1,PLIEN,40,DFN))
Begin DoDot:2
+33 IF $PIECE(^BQICARE(OWNR,1,PLIEN,40,DFN,0),U,2)="A"
IF FLAG="A"
SET RESULT=0
QUIT
+34 IF $PIECE(^BQICARE(OWNR,1,PLIEN,40,DFN,0),U,2)="R"
IF FLAG="R"
SET RESULT=0
QUIT
+35 IF FLAG="A"
DO APTM(DFN)
+36 IF FLAG="R"
DO RPTM(DFN)
End DoDot:2
+37 ;
+38 IF '$DATA(^BQICARE(OWNR,1,PLIEN,40,DFN))
IF FLAG="A"
DO APTM(DFN)
+39 IF '$DATA(^BQICARE(OWNR,1,PLIEN,40,DFN))
IF FLAG="R"
SET RESULT=0
End DoDot:1
+40 ;
+41 SET DIK(1)=".01"
SET DA(2)=OWNR
SET DA(1)=PLIEN
+42 SET DIK="^BQICARE("_DA(2)_",1,"_DA(1)_",40,"
+43 DO ENALL^DIK
+44 ; Get total count of patients
+45 DO CNTP(OWNR,PLIEN)
+46 ;
+47 NEW DA,PIENS,BQIUP
+48 SET DA(1)=OWNR
SET DA=PLIEN
SET PIENS=$$IENS^DILF(.DA)
+49 SET BQIUP(90505.01,PIENS,.09)=$$NOW^XLFDT()
+50 SET BQIUP(90505.01,PIENS,.08)=DUZ
+51 DO FILE^DIE("","BQIUP","ERROR")
+52 ;
+53 SET II=0
SET ^TMP("BQIMANP",UID,II)="I00010RESULT"_$CHAR(30)
+54 SET II=II+1
SET ^TMP("BQIMANP",UID,II)=RESULT_$CHAR(30)
+55 SET II=II+1
SET ^TMP("BQIMANP",UID,II)=$CHAR(31)
+56 QUIT
+57 ;
APTM(DFN) ;EP - Add patient record manually
+1 NEW DA,DATA
+2 SET DA(2)=OWNR
SET DA(1)=PLIEN
+3 IF '$DATA(^BQICARE(DA(2),1,DA(1),40,0))
SET ^BQICARE(DA(2),1,DA(1),40,0)="^90505.04P^^"
+4 ; Update the user for flags for this patient
+5 IF '$DATA(^BQICARE(DA(2),1,"AB",DFN))
DO UPU^BQIFLAG(DFN,OWNR)
+6 ; Update the patient record in panel
+7 SET DATA=DFN_U_"A"_U_DUZ_U_$$NOW^XLFDT()
+8 SET $PIECE(DATA,U,8)=$SELECT($$FLG^BQIULPT(DUZ,PLIEN,DFN)="Y":1,1:0)
+9 SET ^BQICARE(OWNR,1,PLIEN,40,DFN,0)=DATA
+10 SET RESULT=1
+11 QUIT
+12 ;
RPTM(DFN) ;EP - Remove patient record manually
+1 NEW DA,DATA
+2 SET DA(2)=OWNR
SET DA(1)=PLIEN
+3 SET DA=DFN
SET IENS=$$IENS^DILF(.DA)
+4 SET DATA=$GET(^BQICARE(DA(2),1,DA(1),40,DFN,0))
+5 IF DATA=""
SET DATA=DFN
+6 SET $PIECE(DATA,U,2)="R"
SET $PIECE(DATA,U,5)=DUZ
SET $PIECE(DATA,U,6)=$$NOW^XLFDT()
SET $PIECE(DATA,U,8)=0
+7 SET ^BQICARE(DA(2),1,DA(1),40,DFN,0)=DATA
+8 SET RESULT=1
+9 QUIT
+10 ;
CNTP(OWNR,PLIEN) ;EP - Count patients and file the total
+1 ;
+2 ;Input
+3 ; OWNR - Owner of the panel
+4 ; PLIEN - Panel internal entry number
+5 ;
+6 NEW DA,PIENS,DFN,IENS,CNT,BQIUP,SFLG
+7 SET DA(1)=OWNR
SET DA=PLIEN
SET PIENS=$$IENS^DILF(.DA)
+8 SET DFN=0
SET CNT=0
SET SFLG=0
+9 FOR
SET DFN=$ORDER(^BQICARE(OWNR,1,PLIEN,40,DFN))
IF 'DFN
QUIT
Begin DoDot:1
+10 SET DA(2)=OWNR
SET DA(1)=PLIEN
SET DA=DFN
SET IENS=$$IENS^DILF(.DA)
+11 IF $$GET1^DIQ(90505.04,IENS,.02,"I")="R"
QUIT
+12 SET CNT=CNT+1
+13 ; Check for sensitive patient
+14 IF $$SENS^BQIULPT(DFN)="Y"
SET SFLG=1
+15 ; Set flags for patient
+16 DO UPU^BQIFLAG(DFN,OWNR)
End DoDot:1
+17 ;
+18 SET BQIUP(90505.01,PIENS,.1)=CNT
+19 SET BQIUP(90505.01,PIENS,.07)=$$NOW^XLFDT()
+20 SET BQIUP(90505.01,PIENS,3.5)=DUZ
+21 SET BQIUP(90505.01,PIENS,3.6)=SFLG
+22 DO FILE^DIE("I","BQIUP")
+23 ;
+24 ; Count flags for panel
+25 DO CNTP^BQIFLG(OWNR,PLIEN)
+26 QUIT
+27 ;
ERR ;
+1 LOCK -^BQICARE(OWNR,1,0)
+2 DO ^%ZTER
+3 NEW Y,ERRDTM
+4 SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET ERRDTM=Y
+5 SET BMXSEC="Recording that an error occurred at "_ERRDTM
+6 QUIT
