BTPWPWRS ;VNGT/HS/ALA-Update subdefinitions for Worksheet ; 25 Jan 2010 11:34 AM
;;1.0;CARE MANAGEMENT EVENT TRACKING;;Feb 07, 2011
;
;
EN(DATA,BTPWDEF,BTPWTYP,CMIEN,EVIEN,PARMS) ; EP - BTPW UPDATE CMET SUB WRKSHT
; Input parameters
; BTPWDEF - Register or sub-register name
; BTPWTYP - What is to happen to the record (A=Add, E=Edit, D=Delete)
; CMIEN - Tracked Record IEN
; EVIEN - Subrecord IEN
; PARMS - Parameters and their values
;
NEW UID,II,IENS,VFIEN,FILE,DTTM,BTWDATA,BTWP,BTPWP
NEW BTPFNDTM,BTPWPFND,BTPWFNTR,BTPFNCOM,BTPFLND,BTPEDTM,BTPEDBY
NEW BTPFLDTM,BTPWPFOL,BTPWPFLD,BTPWPFCM,BTPWFLER
NEW BTPNDTM,BTPWPNOT,BTPNCOM,BTPWTDOC,BTPWTTMP,BTPWSIGN,TIURSLT
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWPWRS",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWPWRS D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
S @DATA@(II)="I00010RESULT^T01024MSG^I00010HIDE_CMET_IEN^I00010HIDE_EVIEN"_$C(30)
;
;Pull current date/time
S DTTM=$$NOW^XLFDT()
;
S EVIEN=$G(EVIEN,""),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 BTPWDEF="" S BMXSEC="RPC Call Failed: VFILE NAME 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)
;
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
;
I EVIEN="",BTPWTYP="A" D
. ; For findings
. I FILE=90620.01 D FND Q
. ; For followups
. I FILE=90620.012 D FOL Q
. ; For Notifications
. I FILE=90620.011 D NOT Q
;
NEW DA
S DA(1)=CMIEN,DA=EVIEN,IENS=$$IENS^DILF(.DA)
;
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
.. K BTPWP
.. F LN=1:1:$L(@NAME,$C(10)) S P=$P(@NAME,$C(10),LN) S BTPWP(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
;
S BTPWDTA(90620,CMIEN_",",1.09)=$$NOW^XLFDT(),BTPWDTA(90620,CMIEN_",",1.1)=DUZ
I FILE=90620.01 D
. S BTPWDTA(FILE,IENS,.04)=$$NOW^XLFDT()
. S BTPWDTA(FILE,IENS,.05)=DUZ
I FILE'=90620.01 D
. S BTPWDTA(FILE,IENS,.03)=$$NOW^XLFDT()
. S BTPWDTA(FILE,IENS,.04)=DUZ
;
; Remove future record for a followup entered in error
I BTPWTYP="E",FILE=90620.012,$G(BTPWFLER)="Y" D
. ;
. N FLIEN,FLSTAT,FOLP,ERROR
. S FLIEN=$$GET1^DIQ(90620.012,EVIEN_","_CMIEN_",",.06,"I") Q:FLIEN=""
. S FLSTAT=$$GET1^DIQ(90620,FLIEN_",","1.01","I") Q:FLSTAT'="F" ;No longer in Future state, cannot delete
. S FOLP(90620,FLIEN_",",.01)="@"
. S FOLP(90620.012,EVIEN_","_CMIEN_",",.06)="@"
. D FILE^DIE("","FOLP","ERROR")
;
; Code commented out - now being done prior to this update call
; Enter Addendum for entered in error notifications
;I BTPWTYP="E",FILE=90620.011,$G(BTPWNTER)="Y",$G(TIUDA)>0 D
;. ;
;. N %,TIUX,TIURSLT,DFN
;. S DFN=$$GET1^DIQ(90620,CMIEN_",",.02,"I") Q:DFN=""
;. D NOW^%DTC
;. S TIUX(.02)=DFN
;. S TIUX(1301)=%
;. S TIUX(1302)=DUZ
;. S TIUX("TEXT",1,0)="CMET Notification marked as Entered in Error"
;. D MAKEADD^TIUSRVP(.TIURSLT,TIUDA,.TIUX,0)
;. ;
;. ; Save Addendum
;. I +$G(TIURSLT) S BTPWDTA(90620.011,EVIEN_","_CMIEN_",",.1)=TIURSLT
;
; Create a future follow up record for a followup
I BTPWTYP="A",FILE=90620.012 D
. S BTPWDTA(90620.012,IENS,.06)=$$FUT^BTPWBTAD(BTPWPFOL,BTPWPFLD)
;
I BTPWTYP="D" D G DONE
. ;
. ;Log History Entry
. D DLOG^BTPWHIST(FILE,IENS,DUZ,DTTM,"Entry Deleted")
. ; If record being deleted is a followup, check for future record
. I FILE'=90620.012 Q
. NEW FTIEN,DA,DIK
. S FTIEN=$$GET1^DIQ(FILE,IENS,.06,"I")
. I $P($G(^BTPWP(FTIEN,1)),U,1)="F" S DA=FTIEN,DIK="^BTPWP(" D ^DIK Q
. ;Delete entry
. S BTPWUPD(FILE,IENS,.01)="@"
. D FILE^DIE("","BTPWUPD","ERROR")
. K BTPWUPD
;
;Log History Entry
I $D(BTPWDTA)>0 D RLOG^BTPWHIST(.BTPWDTA,DUZ,DTTM,"Worksheet Update")
;
;File the Information
K ERROR
D FILE^DIE("","BTPWDTA","ERROR")
;
; Update comment
I $D(BTPWP)>0 D
. N BQQI,FILE,FIELD,DA,IENS,BTWDATA
. K BTWRD
. S FILE=$O(BTPWP("")),FIELD=$O(BTPWP(FILE,""))
. S DA=$G(EVIEN),DA(1)=CMIEN,IENS=$$IENS^DILF(.DA)
. S BQQI=0 F S BQQI=$O(BTPWP(FILE,FIELD,BQQI)) Q:BQQI="" S BTWRD(FILE,IENS,FIELD,BQQI)=BTPWP(FILE,FIELD,BQQI)
. S BTWDATA=$NA(BTWRD(FILE,IENS,1))
. N COM M COM=BTWRD(FILE,IENS,1)
. ;
. ;Log History Entry
. D WLOG^BTPWHIST(.COM,FILE_":"_FIELD,IENS,DUZ,DTTM,"Worksheet Update")
. ;
. ;Save Comments
. D WP^DIE(FILE,IENS,FIELD,"",BTWDATA,"ERROR")
. K BTWRD,BTWP
;
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)_U_EVIEN
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
;
FND ; EP - Create new findings record
NEW DA,DIC,DLAYGO,IENS,BTUPD,X,DIC,DA,DLAYGO
S DA(1)=CMIEN,X=BTPFNDTM
I '$D(^BTPWP(DA(1),10,0)) S ^BTPWP(DA(1),10,0)="^90620.01^^"
S DIC="^BTPWP("_DA(1)_",10,",DIC(0)="LMNZ",DLAYGO=90620.01,DIC("P")=DLAYGO
K DO,DD D FILE^DICN
S EVIEN=+Y
Q
;
FOL ; EP - Create a new followup record
NEW X,DIC,DA,Y,DIE,IENS
I $G(BTPFLDTM)'="" S X=BTPFLDTM
I $G(BTPFLDTM)="" S (X,BTPFLDTM)=$$NOW^XLFDT()
S DA(1)=CMIEN
S DIC(0)="L",DIC="^BTPWP("_DA(1)_",12,",DIE=DIC
I $G(^BTPWP(DA(1),12,0))="" S ^BTPWP(DA(1),12,0)="^90620.012D^^"
K DO,DD D FILE^DICN
S EVIEN=+Y
Q
;
NOT ; EP - Create a new notification record
NEW X,DA,DIC,IENS,DIE,Y
I $G(BTPNDTM)'="" S X=BTPNDTM
I $G(BTPNDTM)="" S (X,BTPNDTM)=$$DT^XLFDT()
S DA(1)=CMIEN
S DIC(0)="L",DIC="^BTPWP("_DA(1)_",11,",DIE=DIC
I $G(^BTPWP(DA(1),11,0))="" S ^BTPWP(DA(1),11,0)="^90620.011D^^"
K DO,DD D FILE^DICN
S EVIEN=+Y
Q
BTPWPWRS ;VNGT/HS/ALA-Update subdefinitions for Worksheet ; 25 Jan 2010 11:34 AM
+1 ;;1.0;CARE MANAGEMENT EVENT TRACKING;;Feb 07, 2011
+2 ;
+3 ;
EN(DATA,BTPWDEF,BTPWTYP,CMIEN,EVIEN,PARMS) ; EP - BTPW UPDATE CMET SUB WRKSHT
+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 ; CMIEN - Tracked Record IEN
+5 ; EVIEN - Subrecord IEN
+6 ; PARMS - Parameters and their values
+7 ;
+8 NEW UID,II,IENS,VFIEN,FILE,DTTM,BTWDATA,BTWP,BTPWP
+9 NEW BTPFNDTM,BTPWPFND,BTPWFNTR,BTPFNCOM,BTPFLND,BTPEDTM,BTPEDBY
+10 NEW BTPFLDTM,BTPWPFOL,BTPWPFLD,BTPWPFCM,BTPWFLER
+11 NEW BTPNDTM,BTPWPNOT,BTPNCOM,BTPWTDOC,BTPWTTMP,BTPWSIGN,TIURSLT
+12 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+13 SET DATA=$NAME(^TMP("BTPWPWRS",UID))
+14 KILL @DATA
+15 ;
+16 SET II=0
+17 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWPWRS D UNWIND^%ZTER"
+18 SET @DATA@(II)="I00010RESULT^T01024MSG^I00010HIDE_CMET_IEN^I00010HIDE_EVIEN"_$CHAR(30)
+19 ;
+20 ;Pull current date/time
+21 SET DTTM=$$NOW^XLFDT()
+22 ;
+23 SET EVIEN=$GET(EVIEN,"")
SET IENS=""
+24 SET PARMS=$GET(PARMS,"")
+25 IF PARMS=""
Begin DoDot:1
+26 SET LIST=""
SET BN=""
+27 FOR
SET BN=$ORDER(PARMS(BN))
IF BN=""
QUIT
SET LIST=LIST_PARMS(BN)
+28 KILL PARMS
+29 SET PARMS=LIST
+30 KILL LIST
End DoDot:1
+31 ;
+32 IF BTPWDEF=""
SET BMXSEC="RPC Call Failed: VFILE NAME not passed in."
QUIT
+33 SET VFIEN=$ORDER(^BQI(90506.3,"B",BTPWDEF,""))
+34 IF VFIEN=""
SET BMXSEC="RPC Call Failed: "_BTPWDEF_" does not exist."
QUIT
+35 SET FILE=$PIECE(^BQI(90506.3,VFIEN,0),U,2)
+36 ;
+37 FOR BQ=1:1:$LENGTH(PARMS,$CHAR(28))
Begin DoDot:1
+38 SET PDATA=$PIECE(PARMS,$CHAR(28),BQ)
IF PDATA=""
QUIT
+39 SET NAME=$PIECE(PDATA,"=",1)
SET VALUE=$PIECE(PDATA,"=",2,99)
+40 IF VALUE=""
SET VALUE="@"
+41 ;I VALUE="" Q
+42 SET PFIEN=$ORDER(^BQI(90506.3,VFIEN,10,"AC",NAME,""))
+43 IF PFIEN=""
SET BMXSEC=NAME_" not a valid parameter for this update"
QUIT
+44 SET PTYP=$PIECE($GET(^BQI(90506.3,VFIEN,10,PFIEN,1)),U,1)
+45 IF PTYP="D"
SET VALUE=$$DATE^BQIUL1(VALUE)
+46 IF PTYP="C"
Begin DoDot:2
+47 SET CHIEN=$ORDER(^BQI(90506.3,VFIEN,10,PFIEN,5,"B",VALUE,""))
IF CHIEN=""
QUIT
+48 SET VALUE=$PIECE(^BQI(90506.3,VFIEN,10,PFIEN,5,CHIEN,0),U,2)
End DoDot:2
+49 SET @NAME=VALUE
End DoDot:1
IF $GET(BMXSEC)'=""
QUIT
+50 ;
+51 IF EVIEN=""
IF BTPWTYP="A"
Begin DoDot:1
+52 ; For findings
+53 IF FILE=90620.01
DO FND
QUIT
+54 ; For followups
+55 IF FILE=90620.012
DO FOL
QUIT
+56 ; For Notifications
+57 IF FILE=90620.011
DO NOT
QUIT
End DoDot:1
+58 ;
+59 NEW DA
+60 SET DA(1)=CMIEN
SET DA=EVIEN
SET IENS=$$IENS^DILF(.DA)
+61 ;
+62 FOR BQ=1:1:$LENGTH(PARMS,$CHAR(28))
Begin DoDot:1
+63 SET PDATA=$PIECE(PARMS,$CHAR(28),BQ)
IF PDATA=""
QUIT
+64 SET NAME=$PIECE(PDATA,"=",1)
+65 SET PFIEN=$ORDER(^BQI(90506.3,VFIEN,10,"AC",NAME,""))
+66 IF PFIEN=""
SET BMXSEC=NAME_" not a valid parameter for this update"
QUIT
+67 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)
+68 ;Word Processing Field
+69 IF PTYP="W"
Begin DoDot:2
+70 NEW FIELD,LN,I,P
+71 SET FIELD=$PIECE($GET(^BQI(90506.3,VFIEN,10,PFIEN,3)),U,1)
IF FIELD=""
QUIT
+72 IF @NAME="@"
SET BTPWDTA(FILE,IENS,FIELD)="@"
QUIT
+73 KILL BTPWP
+74 FOR LN=1:1:$LENGTH(@NAME,$CHAR(10))
SET P=$PIECE(@NAME,$CHAR(10),LN)
SET BTPWP(FILE,FIELD,LN)=P
End DoDot:2
QUIT
+75 SET EXEC=$GET(^BQI(90506.3,VFIEN,10,PFIEN,7))
+76 IF EXEC'=""
XECUTE EXEC
QUIT
+77 IF FIELD=""
QUIT
+78 IF IENS'=""
SET BTPWDTA(FILE,IENS,FIELD)=@NAME
End DoDot:1
IF $GET(BMXSEC)'=""
QUIT
+79 ;
+80 SET BTPWDTA(90620,CMIEN_",",1.09)=$$NOW^XLFDT()
SET BTPWDTA(90620,CMIEN_",",1.1)=DUZ
+81 IF FILE=90620.01
Begin DoDot:1
+82 SET BTPWDTA(FILE,IENS,.04)=$$NOW^XLFDT()
+83 SET BTPWDTA(FILE,IENS,.05)=DUZ
End DoDot:1
+84 IF FILE'=90620.01
Begin DoDot:1
+85 SET BTPWDTA(FILE,IENS,.03)=$$NOW^XLFDT()
+86 SET BTPWDTA(FILE,IENS,.04)=DUZ
End DoDot:1
+87 ;
+88 ; Remove future record for a followup entered in error
+89 IF BTPWTYP="E"
IF FILE=90620.012
IF $GET(BTPWFLER)="Y"
Begin DoDot:1
+90 ;
+91 NEW FLIEN,FLSTAT,FOLP,ERROR
+92 SET FLIEN=$$GET1^DIQ(90620.012,EVIEN_","_CMIEN_",",.06,"I")
IF FLIEN=""
QUIT
+93 ;No longer in Future state, cannot delete
SET FLSTAT=$$GET1^DIQ(90620,FLIEN_",","1.01","I")
IF FLSTAT'="F"
QUIT
+94 SET FOLP(90620,FLIEN_",",.01)="@"
+95 SET FOLP(90620.012,EVIEN_","_CMIEN_",",.06)="@"
+96 DO FILE^DIE("","FOLP","ERROR")
End DoDot:1
+97 ;
+98 ; Code commented out - now being done prior to this update call
+99 ; Enter Addendum for entered in error notifications
+100 ;I BTPWTYP="E",FILE=90620.011,$G(BTPWNTER)="Y",$G(TIUDA)>0 D
+101 ;. ;
+102 ;. N %,TIUX,TIURSLT,DFN
+103 ;. S DFN=$$GET1^DIQ(90620,CMIEN_",",.02,"I") Q:DFN=""
+104 ;. D NOW^%DTC
+105 ;. S TIUX(.02)=DFN
+106 ;. S TIUX(1301)=%
+107 ;. S TIUX(1302)=DUZ
+108 ;. S TIUX("TEXT",1,0)="CMET Notification marked as Entered in Error"
+109 ;. D MAKEADD^TIUSRVP(.TIURSLT,TIUDA,.TIUX,0)
+110 ;. ;
+111 ;. ; Save Addendum
+112 ;. I +$G(TIURSLT) S BTPWDTA(90620.011,EVIEN_","_CMIEN_",",.1)=TIURSLT
+113 ;
+114 ; Create a future follow up record for a followup
+115 IF BTPWTYP="A"
IF FILE=90620.012
Begin DoDot:1
+116 SET BTPWDTA(90620.012,IENS,.06)=$$FUT^BTPWBTAD(BTPWPFOL,BTPWPFLD)
End DoDot:1
+117 ;
+118 IF BTPWTYP="D"
Begin DoDot:1
+119 ;
+120 ;Log History Entry
+121 DO DLOG^BTPWHIST(FILE,IENS,DUZ,DTTM,"Entry Deleted")
+122 ; If record being deleted is a followup, check for future record
+123 IF FILE'=90620.012
QUIT
+124 NEW FTIEN,DA,DIK
+125 SET FTIEN=$$GET1^DIQ(FILE,IENS,.06,"I")
+126 IF $PIECE($GET(^BTPWP(FTIEN,1)),U,1)="F"
SET DA=FTIEN
SET DIK="^BTPWP("
DO ^DIK
QUIT
+127 ;Delete entry
+128 SET BTPWUPD(FILE,IENS,.01)="@"
+129 DO FILE^DIE("","BTPWUPD","ERROR")
+130 KILL BTPWUPD
End DoDot:1
GOTO DONE
+131 ;
+132 ;Log History Entry
+133 IF $DATA(BTPWDTA)>0
DO RLOG^BTPWHIST(.BTPWDTA,DUZ,DTTM,"Worksheet Update")
+134 ;
+135 ;File the Information
+136 KILL ERROR
+137 DO FILE^DIE("","BTPWDTA","ERROR")
+138 ;
+139 ; Update comment
+140 IF $DATA(BTPWP)>0
Begin DoDot:1
+141 NEW BQQI,FILE,FIELD,DA,IENS,BTWDATA
+142 KILL BTWRD
+143 SET FILE=$ORDER(BTPWP(""))
SET FIELD=$ORDER(BTPWP(FILE,""))
+144 SET DA=$GET(EVIEN)
SET DA(1)=CMIEN
SET IENS=$$IENS^DILF(.DA)
+145 SET BQQI=0
FOR
SET BQQI=$ORDER(BTPWP(FILE,FIELD,BQQI))
IF BQQI=""
QUIT
SET BTWRD(FILE,IENS,FIELD,BQQI)=BTPWP(FILE,FIELD,BQQI)
+146 SET BTWDATA=$NAME(BTWRD(FILE,IENS,1))
+147 NEW COM
MERGE COM=BTWRD(FILE,IENS,1)
+148 ;
+149 ;Log History Entry
+150 DO WLOG^BTPWHIST(.COM,FILE_":"_FIELD,IENS,DUZ,DTTM,"Worksheet Update")
+151 ;
+152 ;Save Comments
+153 DO WP^DIE(FILE,IENS,FIELD,"",BTWDATA,"ERROR")
+154 KILL BTWRD,BTWP
End DoDot:1
+155 ;
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)_U_EVIEN
+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
+7 ;
FND ; EP - Create new findings record
+1 NEW DA,DIC,DLAYGO,IENS,BTUPD,X,DIC,DA,DLAYGO
+2 SET DA(1)=CMIEN
SET X=BTPFNDTM
+3 IF '$DATA(^BTPWP(DA(1),10,0))
SET ^BTPWP(DA(1),10,0)="^90620.01^^"
+4 SET DIC="^BTPWP("_DA(1)_",10,"
SET DIC(0)="LMNZ"
SET DLAYGO=90620.01
SET DIC("P")=DLAYGO
+5 KILL DO,DD
DO FILE^DICN
+6 SET EVIEN=+Y
+7 QUIT
+8 ;
FOL ; EP - Create a new followup record
+1 NEW X,DIC,DA,Y,DIE,IENS
+2 IF $GET(BTPFLDTM)'=""
SET X=BTPFLDTM
+3 IF $GET(BTPFLDTM)=""
SET (X,BTPFLDTM)=$$NOW^XLFDT()
+4 SET DA(1)=CMIEN
+5 SET DIC(0)="L"
SET DIC="^BTPWP("_DA(1)_",12,"
SET DIE=DIC
+6 IF $GET(^BTPWP(DA(1),12,0))=""
SET ^BTPWP(DA(1),12,0)="^90620.012D^^"
+7 KILL DO,DD
DO FILE^DICN
+8 SET EVIEN=+Y
+9 QUIT
+10 ;
NOT ; EP - Create a new notification record
+1 NEW X,DA,DIC,IENS,DIE,Y
+2 IF $GET(BTPNDTM)'=""
SET X=BTPNDTM
+3 IF $GET(BTPNDTM)=""
SET (X,BTPNDTM)=$$DT^XLFDT()
+4 SET DA(1)=CMIEN
+5 SET DIC(0)="L"
SET DIC="^BTPWP("_DA(1)_",11,"
SET DIE=DIC
+6 IF $GET(^BTPWP(DA(1),11,0))=""
SET ^BTPWP(DA(1),11,0)="^90620.011D^^"
+7 KILL DO,DD
DO FILE^DICN
+8 SET EVIEN=+Y
+9 QUIT
