Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BQIPLAP

BQIPLAP.m

Go to the documentation of this file. 
  1. BQIPLAP ;PRXM/HC/ALA-Add Patients ; 11 Sep 2006  5:36 PM
  1.  ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
  1.  ;
  1.  Q
  1.  ;
  1. MANP(DATA,OWNR,PLIEN,FLAG,PLIST) ; EP - BQI MANUAL ADD/REMOVE PATIENTS
  1.  ;
  1.  ;Description
  1.  ;  Manually add a patient or remove a patient from a panel
  1.  ;Input
  1.  ;  OWNR  - Owner of the panel
  1.  ;  PLIEN - Panel internal entry number
  1.  ;  FLAG  - "A" for add, "R" for remove
  1.  ;  PLIST - List of patient IENs separated by $C(28)
  1.  ;DUZ is assumed to be the user signed onto iCare.
  1.  ;DFN is the Patient internal entry number
  1.  ;
  1.  NEW UID,II,X,RESULT,LIST,BN
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIMANP",UID))
  1.  K ^TMP("BQIMANP",UID)
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPLAP D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  ; Check if share and has write access
  1.  I DUZ'=OWNR,'$$CKSHR^BQIPLSH(OWNR,PLIEN) S BMXSEC="You do not have write access" Q
  1.  ;
  1.  S PLIST=$G(PLIST,"")
  1.  I PLIST="" D
  1.  . S LIST="",BN=""
  1.  . F  S BN=$O(PLIST(BN)) Q:BN=""  S LIST=LIST_PLIST(BN)
  1.  . K PLIST
  1.  . S PLIST=LIST
  1.  . K LIST
  1.  F BQI=1:1 S DFN=$P(PLIST,$C(28),BQI) Q:DFN=""  D
  1.  . NEW DA,IENS
  1.  . ;Check if patient is already in panel
  1.  . I $D(^BQICARE(OWNR,1,PLIEN,40,DFN)) D
  1.  .. I $P(^BQICARE(OWNR,1,PLIEN,40,DFN,0),U,2)="A",FLAG="A" S RESULT=0 Q
  1.  .. I $P(^BQICARE(OWNR,1,PLIEN,40,DFN,0),U,2)="R",FLAG="R" S RESULT=0 Q
  1.  .. I FLAG="A" D APTM(DFN)
  1.  .. I FLAG="R" D RPTM(DFN)
  1.  . ;
  1.  . I '$D(^BQICARE(OWNR,1,PLIEN,40,DFN)),FLAG="A" D APTM(DFN)
  1.  . I '$D(^BQICARE(OWNR,1,PLIEN,40,DFN)),FLAG="R" S RESULT=0
  1.  ;
  1.  S DIK(1)=".01",DA(2)=OWNR,DA(1)=PLIEN
  1.  S DIK="^BQICARE("_DA(2)_",1,"_DA(1)_",40,"
  1.  D ENALL^DIK
  1.  ;  Get total count of patients
  1.  D CNTP(OWNR,PLIEN)
  1.  ;
  1.  NEW DA,PIENS,BQIUP
  1.  S DA(1)=OWNR,DA=PLIEN,PIENS=$$IENS^DILF(.DA)
  1.  S BQIUP(90505.01,PIENS,.09)=$$NOW^XLFDT()
  1.  S BQIUP(90505.01,PIENS,.08)=DUZ
  1.  D FILE^DIE("","BQIUP","ERROR")
  1.  ;
  1.  S II=0,^TMP("BQIMANP",UID,II)="I00010RESULT"_$C(30)
  1.  S II=II+1,^TMP("BQIMANP",UID,II)=RESULT_$C(30)
  1.  S II=II+1,^TMP("BQIMANP",UID,II)=$C(31)
  1.  Q
  1.  ;
  1. APTM(DFN) ;EP - Add patient record manually
  1.  NEW DA,DATA
  1.  S DA(2)=OWNR,DA(1)=PLIEN
  1.  I '$D(^BQICARE(DA(2),1,DA(1),40,0)) S ^BQICARE(DA(2),1,DA(1),40,0)="^90505.04P^^"
  1.  ;  Update the user for flags for this patient
  1.  I '$D(^BQICARE(DA(2),1,"AB",DFN)) D UPU^BQIFLAG(DFN,OWNR)
  1.  ;  Update the patient record in panel
  1.  S DATA=DFN_U_"A"_U_DUZ_U_$$NOW^XLFDT()
  1.  S $P(DATA,U,8)=$S($$FLG^BQIULPT(DUZ,PLIEN,DFN)="Y":1,1:0)
  1.  S ^BQICARE(OWNR,1,PLIEN,40,DFN,0)=DATA
  1.  S RESULT=1
  1.  Q
  1.  ;
  1. RPTM(DFN) ;EP - Remove patient record manually
  1.  NEW DA,DATA
  1.  S DA(2)=OWNR,DA(1)=PLIEN
  1.  S DA=DFN,IENS=$$IENS^DILF(.DA)
  1.  S DATA=$G(^BQICARE(DA(2),1,DA(1),40,DFN,0))
  1.  I DATA="" S DATA=DFN
  1.  S $P(DATA,U,2)="R",$P(DATA,U,5)=DUZ,$P(DATA,U,6)=$$NOW^XLFDT(),$P(DATA,U,8)=0
  1.  S ^BQICARE(DA(2),1,DA(1),40,DFN,0)=DATA
  1.  S RESULT=1
  1.  Q
  1.  ;
  1. CNTP(OWNR,PLIEN) ;EP - Count patients and file the total
  1.  ;
  1.  ;Input
  1.  ;  OWNR  - Owner of the panel
  1.  ;  PLIEN - Panel internal entry number
  1.  ;
  1.  NEW DA,PIENS,DFN,IENS,CNT,BQIUP,SFLG
  1.  S DA(1)=OWNR,DA=PLIEN,PIENS=$$IENS^DILF(.DA)
  1.  S DFN=0,CNT=0,SFLG=0
  1.  F  S DFN=$O(^BQICARE(OWNR,1,PLIEN,40,DFN)) Q:'DFN  D
  1.  . S DA(2)=OWNR,DA(1)=PLIEN,DA=DFN,IENS=$$IENS^DILF(.DA)
  1.  . I $$GET1^DIQ(90505.04,IENS,.02,"I")="R" Q
  1.  . S CNT=CNT+1
  1.  . ;  Check for sensitive patient
  1.  . I $$SENS^BQIULPT(DFN)="Y" S SFLG=1
  1.  . ;  Set flags for patient
  1.  . D UPU^BQIFLAG(DFN,OWNR)
  1.  ;
  1.  S BQIUP(90505.01,PIENS,.1)=CNT
  1.  S BQIUP(90505.01,PIENS,.07)=$$NOW^XLFDT()
  1.  S BQIUP(90505.01,PIENS,3.5)=DUZ
  1.  S BQIUP(90505.01,PIENS,3.6)=SFLG
  1.  D FILE^DIE("I","BQIUP")
  1.  ;
  1.  ; Count flags for panel
  1.  D CNTP^BQIFLG(OWNR,PLIEN)
  1.  Q
  1.  ;
  1. ERR ;
  1.  L -^BQICARE(OWNR,1,0)
  1.  D ^%ZTER
  1.  N Y,ERRDTM
  1.  S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
  1.  S BMXSEC="Recording that an error occurred at "_ERRDTM
  1.  Q