BTPWPWRK ;VNGT/HS/ALA-CMET Worksheet Update ; 16 Dec 2009 5:45 PM
;;1.0;CARE MANAGEMENT EVENT TRACKING;;Feb 07, 2011
;
;
EN(DATA,BTPWDEF,BTPWTYP,CMIEN,PARMS) ; EP - BTPW UPDATE CMET WORKSHEET
; Input parameters
; BTPWDEF - Register or sub-register name
; BTPWTYP - What is to happen to the record (A=Add, E=Edit, D=Delete)
; PARMS - Parameters and their values
; CMIEN - Tracked Record IEN
;
NEW UID,II,DTTM,ERROR,BTWP
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWPWRK",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWPWRK D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
S @DATA@(II)="I00010RESULT^T01024MSG^I00010HIDE_CMET_IEN"_$C(30)
;
;Pull current date/time
S DTTM=$$NOW^XLFDT()
;
S CMIEN=$G(CMIEN,""),IENS=""
S PARMS=$G(PARMS,"")
I PARMS="" D
. S LIST="",BN=""
. F S BN=$O(PARMS(BN)) Q:BN="" S LIST=LIST_PARMS(BN)
. K PARMS
. S PARMS=LIST
. K LIST
;
I $G(PARMS)="",BTPWTYP'="D" Q
I BTPWDEF="" S BMXSEC="RPC Call Failed: VDEF Type not passed in." Q
S VFIEN=$O(^BQI(90506.3,"B",BTPWDEF,""))
I VFIEN="" S BMXSEC="RPC Call Failed: "_BTPWDEF_" does not exist." Q
S FILE=$P(^BQI(90506.3,VFIEN,0),U,2)
I CMIEN'="",CMIEN'["," S IENS=CMIEN_","
;
F BQ=1:1:$L(PARMS,$C(28)) D Q:$G(BMXSEC)'=""
. S PDATA=$P(PARMS,$C(28),BQ) Q:PDATA=""
. S NAME=$P(PDATA,"=",1),VALUE=$P(PDATA,"=",2,99)
. I VALUE="" S VALUE="@"
. ;I VALUE="" Q
. S PFIEN=$O(^BQI(90506.3,VFIEN,10,"AC",NAME,""))
. I PFIEN="" S BMXSEC=NAME_" not a valid parameter for this update" Q
. S PTYP=$P($G(^BQI(90506.3,VFIEN,10,PFIEN,1)),U,1)
. I PTYP="D" S VALUE=$$DATE^BQIUL1(VALUE)
. I PTYP="C" D
.. S CHIEN=$O(^BQI(90506.3,VFIEN,10,PFIEN,5,"B",VALUE,"")) I CHIEN="" Q
.. S VALUE=$P(^BQI(90506.3,VFIEN,10,PFIEN,5,CHIEN,0),U,2)
. S @NAME=VALUE
;
F BQ=1:1:$L(PARMS,$C(28)) D Q:$G(BMXSEC)'=""
. S PDATA=$P(PARMS,$C(28),BQ) Q:PDATA=""
. S NAME=$P(PDATA,"=",1)
. S PFIEN=$O(^BQI(90506.3,VFIEN,10,"AC",NAME,""))
. I PFIEN="" S BMXSEC=NAME_" not a valid parameter for this update" Q
. 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)
. ;Word Processing Field
. I PTYP="W" D Q
.. N FIELD,LN,I,P
.. S FIELD=$P($G(^BQI(90506.3,VFIEN,10,PFIEN,3)),U,1) Q:FIELD=""
.. I @NAME="@" S BTPWDTA(FILE,IENS,FIELD)="@" Q
.. F LN=1:1:$L(@NAME,$C(10)) S P=$P(@NAME,$C(10),LN) S BTWP(FILE,FIELD,LN)=P
. S EXEC=$G(^BQI(90506.3,VFIEN,10,PFIEN,7))
. I EXEC'="" X EXEC Q
. I FIELD="" Q
. I IENS'="" S BTPWDTA(FILE,IENS,FIELD)=@NAME
;
I BTPWTYP="E" D G DONE
. ;
. ;Log History Entry
. I $D(BTPWDTA)>0 D RLOG^BTPWHIST(.BTPWDTA,DUZ,DTTM,"Worksheet Update")
. ;
. ;File the Information
. S BTPWDTA(90620,CMIEN_",",1.09)=$$NOW^XLFDT(),BTPWDTA(90620,CMIEN_",",1.1)=DUZ
. D FILE^DIE("","BTPWDTA","ERROR")
. ;
. ;Save comments
. I $D(BTWP(FILE)) D
.. S FIELD="" F S FIELD=$O(BTWP(FILE,FIELD)) Q:FIELD="" D
... N CMTVAR,COM S CMTVAR="BTWP("_FILE_","_FIELD_")"
... M COM=BTWP(FILE,FIELD)
... ;
... ;Log History Entry
... D WLOG^BTPWHIST(.COM,FILE_":"_FIELD,CMIEN_",",DUZ,DTTM,"Worksheet Update")
... ;
... ;Save Comments
... D WP^DIE(90620,CMIEN_",",FIELD,"",CMTVAR)
;
DONE ;
S RESULT=1_U
I $D(ERROR)>0 S RESULT=-1_U_$G(ERROR("DIERR",1,"TEXT",1))_U
I $P(RESULT,U,1)'=-1 S RESULT=1_U_U_$G(CMIEN)
S II=II+1,@DATA@(II)=RESULT_$C(30)
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
S II=II+1,@DATA@(II)=$C(31)
Q
BTPWPWRK ;VNGT/HS/ALA-CMET Worksheet Update ; 16 Dec 2009 5:45 PM
+1 ;;1.0;CARE MANAGEMENT EVENT TRACKING;;Feb 07, 2011
+2 ;
+3 ;
EN(DATA,BTPWDEF,BTPWTYP,CMIEN,PARMS) ; EP - BTPW UPDATE CMET WORKSHEET
+1 ; Input parameters
+2 ; BTPWDEF - Register or sub-register name
+3 ; BTPWTYP - What is to happen to the record (A=Add, E=Edit, D=Delete)
+4 ; PARMS - Parameters and their values
+5 ; CMIEN - Tracked Record IEN
+6 ;
+7 NEW UID,II,DTTM,ERROR,BTWP
+8 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+9 SET DATA=$NAME(^TMP("BTPWPWRK",UID))
+10 KILL @DATA
+11 ;
+12 SET II=0
+13 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWPWRK D UNWIND^%ZTER"
+14 SET @DATA@(II)="I00010RESULT^T01024MSG^I00010HIDE_CMET_IEN"_$CHAR(30)
+15 ;
+16 ;Pull current date/time
+17 SET DTTM=$$NOW^XLFDT()
+18 ;
+19 SET CMIEN=$GET(CMIEN,"")
SET IENS=""
+20 SET PARMS=$GET(PARMS,"")
+21 IF PARMS=""
Begin DoDot:1
+22 SET LIST=""
SET BN=""
+23 FOR
SET BN=$ORDER(PARMS(BN))
IF BN=""
QUIT
SET LIST=LIST_PARMS(BN)
+24 KILL PARMS
+25 SET PARMS=LIST
+26 KILL LIST
End DoDot:1
+27 ;
+28 IF $GET(PARMS)=""
IF BTPWTYP'="D"
QUIT
+29 IF BTPWDEF=""
SET BMXSEC="RPC Call Failed: VDEF Type not passed in."
QUIT
+30 SET VFIEN=$ORDER(^BQI(90506.3,"B",BTPWDEF,""))
+31 IF VFIEN=""
SET BMXSEC="RPC Call Failed: "_BTPWDEF_" does not exist."
QUIT
+32 SET FILE=$PIECE(^BQI(90506.3,VFIEN,0),U,2)
+33 IF CMIEN'=""
IF CMIEN'[","
SET IENS=CMIEN_","
+34 ;
+35 FOR BQ=1:1:$LENGTH(PARMS,$CHAR(28))
Begin DoDot:1
+36 SET PDATA=$PIECE(PARMS,$CHAR(28),BQ)
IF PDATA=""
QUIT
+37 SET NAME=$PIECE(PDATA,"=",1)
SET VALUE=$PIECE(PDATA,"=",2,99)
+38 IF VALUE=""
SET VALUE="@"
+39 ;I VALUE="" Q
+40 SET PFIEN=$ORDER(^BQI(90506.3,VFIEN,10,"AC",NAME,""))
+41 IF PFIEN=""
SET BMXSEC=NAME_" not a valid parameter for this update"
QUIT
+42 SET PTYP=$PIECE($GET(^BQI(90506.3,VFIEN,10,PFIEN,1)),U,1)
+43 IF PTYP="D"
SET VALUE=$$DATE^BQIUL1(VALUE)
+44 IF PTYP="C"
Begin DoDot:2
+45 SET CHIEN=$ORDER(^BQI(90506.3,VFIEN,10,PFIEN,5,"B",VALUE,""))
IF CHIEN=""
QUIT
+46 SET VALUE=$PIECE(^BQI(90506.3,VFIEN,10,PFIEN,5,CHIEN,0),U,2)
End DoDot:2
+47 SET @NAME=VALUE
End DoDot:1
IF $GET(BMXSEC)'=""
QUIT
+48 ;
+49 FOR BQ=1:1:$LENGTH(PARMS,$CHAR(28))
Begin DoDot:1
+50 SET PDATA=$PIECE(PARMS,$CHAR(28),BQ)
IF PDATA=""
QUIT
+51 SET NAME=$PIECE(PDATA,"=",1)
+52 SET PFIEN=$ORDER(^BQI(90506.3,VFIEN,10,"AC",NAME,""))
+53 IF PFIEN=""
SET BMXSEC=NAME_" not a valid parameter for this update"
QUIT
+54 SET FIELD=$PIECE($GET(^BQI(90506.3,VFIEN,10,PFIEN,3)),U,1)
SET PTYP=$PIECE($GET(^BQI(90506.3,VFIEN,10,PFIEN,1)),U,1)
+55 ;Word Processing Field
+56 IF PTYP="W"
Begin DoDot:2
+57 NEW FIELD,LN,I,P
+58 SET FIELD=$PIECE($GET(^BQI(90506.3,VFIEN,10,PFIEN,3)),U,1)
IF FIELD=""
QUIT
+59 IF @NAME="@"
SET BTPWDTA(FILE,IENS,FIELD)="@"
QUIT
+60 FOR LN=1:1:$LENGTH(@NAME,$CHAR(10))
SET P=$PIECE(@NAME,$CHAR(10),LN)
SET BTWP(FILE,FIELD,LN)=P
End DoDot:2
QUIT
+61 SET EXEC=$GET(^BQI(90506.3,VFIEN,10,PFIEN,7))
+62 IF EXEC'=""
XECUTE EXEC
QUIT
+63 IF FIELD=""
QUIT
+64 IF IENS'=""
SET BTPWDTA(FILE,IENS,FIELD)=@NAME
End DoDot:1
IF $GET(BMXSEC)'=""
QUIT
+65 ;
+66 IF BTPWTYP="E"
Begin DoDot:1
+67 ;
+68 ;Log History Entry
+69 IF $DATA(BTPWDTA)>0
DO RLOG^BTPWHIST(.BTPWDTA,DUZ,DTTM,"Worksheet Update")
+70 ;
+71 ;File the Information
+72 SET BTPWDTA(90620,CMIEN_",",1.09)=$$NOW^XLFDT()
SET BTPWDTA(90620,CMIEN_",",1.1)=DUZ
+73 DO FILE^DIE("","BTPWDTA","ERROR")
+74 ;
+75 ;Save comments
+76 IF $DATA(BTWP(FILE))
Begin DoDot:2
+77 SET FIELD=""
FOR
SET FIELD=$ORDER(BTWP(FILE,FIELD))
IF FIELD=""
QUIT
Begin DoDot:3
+78 NEW CMTVAR,COM
SET CMTVAR="BTWP("_FILE_","_FIELD_")"
+79 MERGE COM=BTWP(FILE,FIELD)
+80 ;
+81 ;Log History Entry
+82 DO WLOG^BTPWHIST(.COM,FILE_":"_FIELD,CMIEN_",",DUZ,DTTM,"Worksheet Update")
+83 ;
+84 ;Save Comments
+85 DO WP^DIE(90620,CMIEN_",",FIELD,"",CMTVAR)
End DoDot:3
End DoDot:2
End DoDot:1
GOTO DONE
+86 ;
DONE ;
+1 SET RESULT=1_U
+2 IF $DATA(ERROR)>0
SET RESULT=-1_U_$GET(ERROR("DIERR",1,"TEXT",1))_U
+3 IF $PIECE(RESULT,U,1)'=-1
SET RESULT=1_U_U_$GET(CMIEN)
+4 SET II=II+1
SET @DATA@(II)=RESULT_$CHAR(30)
+5 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+6 QUIT
+7 ;
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 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+6 QUIT
