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

BTPWPWRS.m

Go to the documentation of this file. 
  1. BTPWPWRS ;VNGT/HS/ALA-Update subdefinitions for Worksheet ; 25 Jan 2010  11:34 AM
  1.  ;;1.0;CARE MANAGEMENT EVENT TRACKING;;Feb 07, 2011
  1.  ;
  1.  ;
  1. EN(DATA,BTPWDEF,BTPWTYP,CMIEN,EVIEN,PARMS) ; EP - BTPW UPDATE CMET SUB WRKSHT
  1.  ; Input parameters
  1.  ;   BTPWDEF - Register or sub-register name
  1.  ;   BTPWTYP - What is to happen to the record (A=Add, E=Edit, D=Delete)
  1.  ;   CMIEN  - Tracked Record IEN
  1.  ;   EVIEN  - Subrecord IEN
  1.  ;   PARMS  - Parameters and their values
  1.  ;
  1.  NEW UID,II,IENS,VFIEN,FILE,DTTM,BTWDATA,BTWP,BTPWP
  1.  NEW BTPFNDTM,BTPWPFND,BTPWFNTR,BTPFNCOM,BTPFLND,BTPEDTM,BTPEDBY
  1.  NEW BTPFLDTM,BTPWPFOL,BTPWPFLD,BTPWPFCM,BTPWFLER
  1.  NEW BTPNDTM,BTPWPNOT,BTPNCOM,BTPWTDOC,BTPWTTMP,BTPWSIGN,TIURSLT
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BTPWPWRS",UID))
  1.  K @DATA
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWPWRS D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  S @DATA@(II)="I00010RESULT^T01024MSG^I00010HIDE_CMET_IEN^I00010HIDE_EVIEN"_$C(30)
  1.  ;
  1.  ;Pull current date/time
  1.  S DTTM=$$NOW^XLFDT()
  1.  ;
  1.  S EVIEN=$G(EVIEN,""),IENS=""
  1.  S PARMS=$G(PARMS,"")
  1.  I PARMS="" D
  1.  . S LIST="",BN=""
  1.  . F  S BN=$O(PARMS(BN)) Q:BN=""  S LIST=LIST_PARMS(BN)
  1.  . K PARMS
  1.  . S PARMS=LIST
  1.  . K LIST
  1.  ;
  1.  I BTPWDEF="" S BMXSEC="RPC Call Failed: VFILE NAME not passed in." Q
  1.  S VFIEN=$O(^BQI(90506.3,"B",BTPWDEF,""))
  1.  I VFIEN="" S BMXSEC="RPC Call Failed: "_BTPWDEF_" does not exist." Q
  1.  S FILE=$P(^BQI(90506.3,VFIEN,0),U,2)
  1.  ;
  1.  F BQ=1:1:$L(PARMS,$C(28)) D  Q:$G(BMXSEC)'=""
  1.  . S PDATA=$P(PARMS,$C(28),BQ) Q:PDATA=""
  1.  . S NAME=$P(PDATA,"=",1),VALUE=$P(PDATA,"=",2,99)
  1.  . I VALUE="" S VALUE="@"
  1.  . ;I VALUE="" Q
  1.  . S PFIEN=$O(^BQI(90506.3,VFIEN,10,"AC",NAME,""))
  1.  . I PFIEN="" S BMXSEC=NAME_" not a valid parameter for this update" Q
  1.  . S PTYP=$P($G(^BQI(90506.3,VFIEN,10,PFIEN,1)),U,1)
  1.  . I PTYP="D" S VALUE=$$DATE^BQIUL1(VALUE)
  1.  . I PTYP="C" D
  1.  .. S CHIEN=$O(^BQI(90506.3,VFIEN,10,PFIEN,5,"B",VALUE,"")) I CHIEN="" Q
  1.  .. S VALUE=$P(^BQI(90506.3,VFIEN,10,PFIEN,5,CHIEN,0),U,2)
  1.  . S @NAME=VALUE
  1.  ;
  1.  I EVIEN="",BTPWTYP="A" D
  1.  . ; For findings
  1.  . I FILE=90620.01 D FND Q
  1.  . ; For followups
  1.  . I FILE=90620.012 D FOL Q
  1.  . ; For Notifications
  1.  . I FILE=90620.011 D NOT Q
  1.  ;
  1.  NEW DA
  1.  S DA(1)=CMIEN,DA=EVIEN,IENS=$$IENS^DILF(.DA)
  1.  ;
  1.  F BQ=1:1:$L(PARMS,$C(28)) D  Q:$G(BMXSEC)'=""
  1.  . S PDATA=$P(PARMS,$C(28),BQ) Q:PDATA=""
  1.  . S NAME=$P(PDATA,"=",1)
  1.  . S PFIEN=$O(^BQI(90506.3,VFIEN,10,"AC",NAME,""))
  1.  . I PFIEN="" S BMXSEC=NAME_" not a valid parameter for this update" Q
  1.  . S FIELD=$P($G(^BQI(90506.3,VFIEN,10,PFIEN,3)),U,1),PTYP=$P($G(^BQI(90506.3,VFIEN,10,PFIEN,1)),U,1)
  1.  . ;Word Processing Field
  1.  . I PTYP="W" D  Q
  1.  .. N FIELD,LN,I,P
  1.  .. S FIELD=$P($G(^BQI(90506.3,VFIEN,10,PFIEN,3)),U,1) Q:FIELD=""
  1.  .. I @NAME="@" S BTPWDTA(FILE,IENS,FIELD)="@" Q
  1.  .. K BTPWP
  1.  .. F LN=1:1:$L(@NAME,$C(10)) S P=$P(@NAME,$C(10),LN) S BTPWP(FILE,FIELD,LN)=P
  1.  . S EXEC=$G(^BQI(90506.3,VFIEN,10,PFIEN,7))
  1.  . I EXEC'="" X EXEC Q
  1.  . I FIELD="" Q
  1.  . I IENS'="" S BTPWDTA(FILE,IENS,FIELD)=@NAME
  1.  ;
  1.  S BTPWDTA(90620,CMIEN_",",1.09)=$$NOW^XLFDT(),BTPWDTA(90620,CMIEN_",",1.1)=DUZ
  1.  I FILE=90620.01 D
  1.  . S BTPWDTA(FILE,IENS,.04)=$$NOW^XLFDT()
  1.  . S BTPWDTA(FILE,IENS,.05)=DUZ
  1.  I FILE'=90620.01 D
  1.  . S BTPWDTA(FILE,IENS,.03)=$$NOW^XLFDT()
  1.  . S BTPWDTA(FILE,IENS,.04)=DUZ
  1.  ;
  1.  ; Remove future record for a followup entered in error
  1.  I BTPWTYP="E",FILE=90620.012,$G(BTPWFLER)="Y" D
  1.  . ;
  1.  . N FLIEN,FLSTAT,FOLP,ERROR
  1.  . S FLIEN=$$GET1^DIQ(90620.012,EVIEN_","_CMIEN_",",.06,"I") Q:FLIEN=""
  1.  . S FLSTAT=$$GET1^DIQ(90620,FLIEN_",","1.01","I") Q:FLSTAT'="F"  ;No longer in Future state, cannot delete
  1.  . S FOLP(90620,FLIEN_",",.01)="@"
  1.  . S FOLP(90620.012,EVIEN_","_CMIEN_",",.06)="@"
  1.  . D FILE^DIE("","FOLP","ERROR")
  1.  ;
  1.  ; Code commented out - now being done prior to this update call
  1.  ; Enter Addendum for entered in error notifications
  1.  ;I BTPWTYP="E",FILE=90620.011,$G(BTPWNTER)="Y",$G(TIUDA)>0 D
  1.  ;. ;
  1.  ;. N %,TIUX,TIURSLT,DFN
  1.  ;. S DFN=$$GET1^DIQ(90620,CMIEN_",",.02,"I") Q:DFN=""
  1.  ;. D NOW^%DTC
  1.  ;. S TIUX(.02)=DFN
  1.  ;. S TIUX(1301)=%
  1.  ;. S TIUX(1302)=DUZ
  1.  ;. S TIUX("TEXT",1,0)="CMET Notification marked as Entered in Error"
  1.  ;. D MAKEADD^TIUSRVP(.TIURSLT,TIUDA,.TIUX,0)
  1.  ;. ;
  1.  ;. ; Save Addendum
  1.  ;. I +$G(TIURSLT) S BTPWDTA(90620.011,EVIEN_","_CMIEN_",",.1)=TIURSLT
  1.  ;
  1.  ; Create a future follow up record for a followup
  1.  I BTPWTYP="A",FILE=90620.012 D
  1.  . S BTPWDTA(90620.012,IENS,.06)=$$FUT^BTPWBTAD(BTPWPFOL,BTPWPFLD)
  1.  ;
  1.  I BTPWTYP="D" D  G DONE
  1.  . ;
  1.  . ;Log History Entry
  1.  . D DLOG^BTPWHIST(FILE,IENS,DUZ,DTTM,"Entry Deleted")
  1.  . ; If record being deleted is a followup, check for future record
  1.  . I FILE'=90620.012 Q
  1.  . NEW FTIEN,DA,DIK
  1.  . S FTIEN=$$GET1^DIQ(FILE,IENS,.06,"I")
  1.  . I $P($G(^BTPWP(FTIEN,1)),U,1)="F" S DA=FTIEN,DIK="^BTPWP(" D ^DIK Q
  1.  . ;Delete entry
  1.  . S BTPWUPD(FILE,IENS,.01)="@"
  1.  . D FILE^DIE("","BTPWUPD","ERROR")
  1.  . K BTPWUPD
  1.  ;
  1.  ;Log History Entry
  1.  I $D(BTPWDTA)>0 D RLOG^BTPWHIST(.BTPWDTA,DUZ,DTTM,"Worksheet Update")
  1.  ;
  1.  ;File the Information
  1.  K ERROR
  1.  D FILE^DIE("","BTPWDTA","ERROR")
  1.  ;
  1.  ; Update comment
  1.  I $D(BTPWP)>0 D
  1.  . N BQQI,FILE,FIELD,DA,IENS,BTWDATA
  1.  . K BTWRD
  1.  . S FILE=$O(BTPWP("")),FIELD=$O(BTPWP(FILE,""))
  1.  . S DA=$G(EVIEN),DA(1)=CMIEN,IENS=$$IENS^DILF(.DA)
  1.  . S BQQI=0 F  S BQQI=$O(BTPWP(FILE,FIELD,BQQI)) Q:BQQI=""  S BTWRD(FILE,IENS,FIELD,BQQI)=BTPWP(FILE,FIELD,BQQI)
  1.  . S BTWDATA=$NA(BTWRD(FILE,IENS,1))
  1.  . N COM M COM=BTWRD(FILE,IENS,1)
  1.  . ;
  1.  . ;Log History Entry
  1.  . D WLOG^BTPWHIST(.COM,FILE_":"_FIELD,IENS,DUZ,DTTM,"Worksheet Update")
  1.  . ;
  1.  . ;Save Comments
  1.  . D WP^DIE(FILE,IENS,FIELD,"",BTWDATA,"ERROR")
  1.  . K BTWRD,BTWP
  1.  ;
  1. DONE ;
  1.  S RESULT=1_U
  1.  I $D(ERROR)>0 S RESULT=-1_U_$G(ERROR("DIERR",1,"TEXT",1))_U
  1.  I $P(RESULT,U,1)'=-1 S RESULT=1_U_U_$G(CMIEN)_U_EVIEN
  1.  S II=II+1,@DATA@(II)=RESULT_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. ERR ;
  1.  D ^%ZTER
  1.  NEW Y,ERRDTM
  1.  S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
  1.  S BMXSEC="Recording that an error occurred at "_ERRDTM
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. FND ; EP - Create new findings record
  1.  NEW DA,DIC,DLAYGO,IENS,BTUPD,X,DIC,DA,DLAYGO
  1.  S DA(1)=CMIEN,X=BTPFNDTM
  1.  I '$D(^BTPWP(DA(1),10,0)) S ^BTPWP(DA(1),10,0)="^90620.01^^"
  1.  S DIC="^BTPWP("_DA(1)_",10,",DIC(0)="LMNZ",DLAYGO=90620.01,DIC("P")=DLAYGO
  1.  K DO,DD D FILE^DICN
  1.  S EVIEN=+Y
  1.  Q
  1.  ;
  1. FOL ; EP - Create a new followup record
  1.  NEW X,DIC,DA,Y,DIE,IENS
  1.  I $G(BTPFLDTM)'="" S X=BTPFLDTM
  1.  I $G(BTPFLDTM)="" S (X,BTPFLDTM)=$$NOW^XLFDT()
  1.  S DA(1)=CMIEN
  1.  S DIC(0)="L",DIC="^BTPWP("_DA(1)_",12,",DIE=DIC
  1.  I $G(^BTPWP(DA(1),12,0))="" S ^BTPWP(DA(1),12,0)="^90620.012D^^"
  1.  K DO,DD D FILE^DICN
  1.  S EVIEN=+Y
  1.  Q
  1.  ;
  1. NOT ; EP - Create a new notification record
  1.  NEW X,DA,DIC,IENS,DIE,Y
  1.  I $G(BTPNDTM)'="" S X=BTPNDTM
  1.  I $G(BTPNDTM)="" S (X,BTPNDTM)=$$DT^XLFDT()
  1.  S DA(1)=CMIEN
  1.  S DIC(0)="L",DIC="^BTPWP("_DA(1)_",11,",DIE=DIC
  1.  I $G(^BTPWP(DA(1),11,0))="" S ^BTPWP(DA(1),11,0)="^90620.011D^^"
  1.  K DO,DD D FILE^DICN
  1.  S EVIEN=+Y
  1.  Q