EC2P24PT ;ALB/JAM - PATCH EC*2.0*24 Post-Init Rtn ; 04/19/00
;;2.0; EVENT CAPTURE ;**24**;04 Apr 2000
;
POST ; entry point
;* search file #725 for invalid CPT IENs then file 721.
S ECJ=$J K ^TMP(ECJ,"EC2P24")
D F725SRH
D BKGPRC
D MES^XPDUTL(" ")
D BMES^XPDUTL(" completed...")
D MES^XPDUTL(" ")
Q
;
F725SRH ; Locate invalid CPT codes in file 725 and correct them
N IEN,CPT,ECX,DA,DIE,CPTIEN,DR
S IEN=0
D MES^XPDUTL(" ")
D BMES^XPDUTL("Correcting CPT IEN in EC NATIONAL PROCEDURE file(#725)...")
D MES^XPDUTL(" ")
F S IEN=$O(^EC(725,IEN)) Q:'IEN D
. S ECX=$G(^EC(725,IEN,0)),CPT=$P(ECX,U,5) I CPT="" Q
. I $D(^ICPT(CPT)) Q
. I $D(^ICPT("B",CPT)) D Q
. . S CPTIEN=$O(^ICPT("B",CPT,0))
. . I CPTIEN="" S ^TMP(ECJ,"EC2P24","F725",IEN)=CPT_U_ECX Q
. . K DIE,DR S DA=IEN,DR="4////"_CPTIEN,DIE="^EC(725," D ^DIE K DR
. . D MES^XPDUTL(" ")
. . D BMES^XPDUTL(" Entry #"_IEN_" for "_$P(ECX,U)_" ["_$P(ECX,U,2)_"]")
. . D BMES^XPDUTL(" ...updated to use CPT IEN "_CPTIEN_".")
. S ^TMP(ECJ,"EC2P24","F725",IEN)=CPT_U_ECX Q
Q
;
F721SRH ; Locate invalid CPT code in file 721 and corrects it
N ECD,ECSD,ECED,ECPT,EC,ECDA,FLG,ERR,CPTIEN,X,Y
S %DT="X",X="12/22/99" D ^%DT S ECSD=Y,ECD=ECSD-.1
D NOW^%DTC S ECED=%
F S ECD=$O(^ECH("AC",ECD)) Q:'ECD Q:ECD>ECED S ECDA=0 D
. F S ECDA=$O(^ECH("AC",ECD,ECDA)) Q:'ECDA D
. . S EC=$G(^ECH(ECDA,"P")),ECPT=$P(EC,U),ERR=0 I ECPT="" Q
. . I $D(^ICPT(ECPT)) Q
. . S EC(0)=$G(^ECH(ECDA,0)) I EC(0)="" Q
. . D
. . . S CPTIEN=$O(^ICPT("B",ECPT,0)) I CPTIEN="" S ERR=1 Q
. . . I '$D(^ICPT(CPTIEN)) S ERR=1 Q
. . . S $P(^ECH(ECDA,"P"),U)=CPTIEN
. . . S FLG=$$FIX721(ECDA,.EC)
. . S ^TMP(ECJ,"EC2P24","F721",ECDA)=ECPT_U_ERR_U_EC(0)
K DIE,DA,DR
Q
;
MSGTXT ; Message intro
;; Please forward this message to your local DSS Site Manager or
;; Event Capture ADPAC.
;;
;; A review of the EVENT CAPTURE PATIENT file (#721) was done on
;; CPT codes for the period 12/22/99-present. This message provides
;; the result of encounters found with invalid CPT code during that
;; period. If the encounter had a CPT code that was stored in its
;; external format it was corrected with the corresponding internal
;; entry number and shows on the list below with a status of 'C'.
;; If the entry status is shown as 'NC', the user should use the
;; 'Enter/Edit Patient Procedures' [ECPAT] option to correct these
;; entries to have the proper CPT code.
;;
;;QUIT
;
BKGPRC ;* print entrie with invalid CPT codes
D BMES^XPDUTL("You will receive a MailMan message regarding invalid CPT entries in file #721 and #725")
D BMES^XPDUTL(" ")
S ZTRTN="PROCESS^EC2P24PT",ZTDESC="File #721 Review from EC*2*24"
S ZTIO="",ZTDTH=$H,ZTREQ="@",ZTSAVE("ZTREQ")="",ZTSAVE("ECJ")="" D ^%ZTLOAD
Q
;
PROCESS ;* background job entry point
N IEN,COUNT,TXTVAR,BL,ECDT,ECY,I,STA,ECPT
D F721SRH
S COUNT=0,$P(BL," ",40)=" "
F I=1:1 S TXTVAR=$P($T(MSGTXT+I),";;",2) Q:TXTVAR="QUIT" D LINE(TXTVAR)
D LINE(" ")
D LINE(" ")
D LINE("721 IEN PATIENT IEN DATE/TIME OLD/NEW CPT CODE STA")
D LINE("------- ----------- --------- ---------------- ---")
S IEN=0
F S IEN=$O(^TMP(ECJ,"EC2P24","F721",IEN)) Q:'IEN D
. S ECX=^TMP(ECJ,"EC2P24","F721",IEN),STA=$P(ECX,U,2)
. S STA=$S(STA:"NC",1:"C")
. S ECPT=$P(ECX,U)_"/"_$S(STA:"",1:$P($G(^ECH(IEN,"P")),U))
. S Y=$P(ECX,U,5) X ^DD("DD") S ECDT=Y
. S ECY=$E(IEN_BL,1,15)_$E($P(ECX,U,4)_BL,1,15)_$E(ECDT_BL,1,24)
. S ECY=ECY_$E(ECPT_BL,1,20)_STA
. D LINE(ECY)
I $D(^TMP(ECJ,"EC2P24","F721")) D
. D LINE(" ")
. D LINE("C - Corrected")
. D LINE("NC - Not Corrected")
I $D(^TMP(ECJ,"EC2P24","F725")) D
. D LINE(" ")
. D LINE(" ")
. D LINE(" ")
. D LINE("CPT entries found in EC NATIONAL PROCEDURE FILE #725")
. D LINE("that could not be located in the CPT file #81")
. D LINE(" ")
. D LINE("725 IEN EC NATIONAL CODE CPT CODE")
. D LINE("------- ---------------- --------")
. S IEN=0 F S IEN=$O(^TMP(ECJ,"EC2P24","F725",IEN)) Q:'IEN D
. . S ECX=^TMP(ECJ,"EC2P24","F725",IEN)
. . S ECY=$E(IEN_BL,1,15)_$E($P(ECX,U,2)_BL,1,36)_" "_$P(ECX,U)
. . D LINE(ECY)
I '$D(^TMP(ECJ,"EC2P24","F721")) D
.D LINE(" ")
.D LINE(" No entries found in EVENT CAPTURE PATIENT file #721 that")
.D LINE(" needs correction.")
.D LINE(" ")
K ^TMP(ECJ,"EC2P24","F721"),^TMP(ECJ,"EC2P24","F725")
D MAIL
K ^TMP(ECJ,"EC2P24"),ECJ
Q
;
LINE(TEXT) ; Add line to message global
S COUNT=COUNT+1,^TMP(ECJ,"EC2P24",COUNT)=TEXT
Q
;
MAIL ; Send message
N XMDUZ,XMY,XMTEXT,XMSUB
S XMY(DUZ)="",XMDUZ=.5
S XMSUB="Event Capture Patient CPT Code Review"
S XMTEXT="^TMP(ECJ,""EC2P24"","
D ^XMD
Q
FIX721(ECFN,EC) ;Fix bad CPT code entry in file #721
; Input: ECFN - Event Capture file #721 IEN
; EC - Zero (0) and "P" nodes in file #721
;
; Output: - Returns 1 if fixed and 0 if failed
;
N EC4,ECDX,ECP,ECCPT,ECINP,ECPCE,ECD,NODE,ECDT
S EC4=$P(EC(0),"^",19),ECDX=$P(EC,"^",2),ECP=$P(EC(0),"^",9)
S ECCPT=$S(ECP["EC":$P($G(^EC(725,+ECP,0)),"^",5),1:+ECP)
S ECINP=$P(EC(0),"^",22),ECD=$P(EC(0),"^",7),NODE=$G(^ECD(ECD,0))
S ECPCE="U~"_$S($P(NODE,"^",14)]"":$P(NODE,"^",14),1:"N")
D NOW^%DTC S ECDT=%
D PCEE^ECBEN2U
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEC2P24PT 5413 printed Apr 09, 2024@21:04:25 Page 2
EC2P24PT ;ALB/JAM - PATCH EC*2.0*24 Post-Init Rtn ; 04/19/00
+1 ;;2.0; EVENT CAPTURE ;**24**;04 Apr 2000
+2 ;
POST ; entry point
+1 ;* search file #725 for invalid CPT IENs then file 721.
+2 SET ECJ=$JOB
KILL ^TMP(ECJ,"EC2P24")
+3 DO F725SRH
+4 DO BKGPRC
+5 DO MES^XPDUTL(" ")
+6 DO BMES^XPDUTL(" completed...")
+7 DO MES^XPDUTL(" ")
+8 QUIT
+9 ;
F725SRH ; Locate invalid CPT codes in file 725 and correct them
+1 NEW IEN,CPT,ECX,DA,DIE,CPTIEN,DR
+2 SET IEN=0
+3 DO MES^XPDUTL(" ")
+4 DO BMES^XPDUTL("Correcting CPT IEN in EC NATIONAL PROCEDURE file(#725)...")
+5 DO MES^XPDUTL(" ")
+6 FOR
SET IEN=$ORDER(^EC(725,IEN))
if 'IEN
QUIT
Begin DoDot:1
+7 SET ECX=$GET(^EC(725,IEN,0))
SET CPT=$PIECE(ECX,U,5)
IF CPT=""
QUIT
+8 IF $DATA(^ICPT(CPT))
QUIT
+9 IF $DATA(^ICPT("B",CPT))
Begin DoDot:2
+10 SET CPTIEN=$ORDER(^ICPT("B",CPT,0))
+11 IF CPTIEN=""
SET ^TMP(ECJ,"EC2P24","F725",IEN)=CPT_U_ECX
QUIT
+12 KILL DIE,DR
SET DA=IEN
SET DR="4////"_CPTIEN
SET DIE="^EC(725,"
DO ^DIE
KILL DR
+13 DO MES^XPDUTL(" ")
+14 DO BMES^XPDUTL(" Entry #"_IEN_" for "_$PIECE(ECX,U)_" ["_$PIECE(ECX,U,2)_"]")
+15 DO BMES^XPDUTL(" ...updated to use CPT IEN "_CPTIEN_".")
End DoDot:2
QUIT
+16 SET ^TMP(ECJ,"EC2P24","F725",IEN)=CPT_U_ECX
QUIT
End DoDot:1
+17 QUIT
+18 ;
F721SRH ; Locate invalid CPT code in file 721 and corrects it
+1 NEW ECD,ECSD,ECED,ECPT,EC,ECDA,FLG,ERR,CPTIEN,X,Y
+2 SET %DT="X"
SET X="12/22/99"
DO ^%DT
SET ECSD=Y
SET ECD=ECSD-.1
+3 DO NOW^%DTC
SET ECED=%
+4 FOR
SET ECD=$ORDER(^ECH("AC",ECD))
if 'ECD
QUIT
if ECD>ECED
QUIT
SET ECDA=0
Begin DoDot:1
+5 FOR
SET ECDA=$ORDER(^ECH("AC",ECD,ECDA))
if 'ECDA
QUIT
Begin DoDot:2
+6 SET EC=$GET(^ECH(ECDA,"P"))
SET ECPT=$PIECE(EC,U)
SET ERR=0
IF ECPT=""
QUIT
+7 IF $DATA(^ICPT(ECPT))
QUIT
+8 SET EC(0)=$GET(^ECH(ECDA,0))
IF EC(0)=""
QUIT
+9 Begin DoDot:3
+10 SET CPTIEN=$ORDER(^ICPT("B",ECPT,0))
IF CPTIEN=""
SET ERR=1
QUIT
+11 IF '$DATA(^ICPT(CPTIEN))
SET ERR=1
QUIT
+12 SET $PIECE(^ECH(ECDA,"P"),U)=CPTIEN
+13 SET FLG=$$FIX721(ECDA,.EC)
End DoDot:3
+14 SET ^TMP(ECJ,"EC2P24","F721",ECDA)=ECPT_U_ERR_U_EC(0)
End DoDot:2
End DoDot:1
+15 KILL DIE,DA,DR
+16 QUIT
+17 ;
MSGTXT ; Message intro
+1 ;; Please forward this message to your local DSS Site Manager or
+2 ;; Event Capture ADPAC.
+3 ;;
+4 ;; A review of the EVENT CAPTURE PATIENT file (#721) was done on
+5 ;; CPT codes for the period 12/22/99-present. This message provides
+6 ;; the result of encounters found with invalid CPT code during that
+7 ;; period. If the encounter had a CPT code that was stored in its
+8 ;; external format it was corrected with the corresponding internal
+9 ;; entry number and shows on the list below with a status of 'C'.
+10 ;; If the entry status is shown as 'NC', the user should use the
+11 ;; 'Enter/Edit Patient Procedures' [ECPAT] option to correct these
+12 ;; entries to have the proper CPT code.
+13 ;;
+14 ;;QUIT
+15 ;
BKGPRC ;* print entrie with invalid CPT codes
+1 DO BMES^XPDUTL("You will receive a MailMan message regarding invalid CPT entries in file #721 and #725")
+2 DO BMES^XPDUTL(" ")
+3 SET ZTRTN="PROCESS^EC2P24PT"
SET ZTDESC="File #721 Review from EC*2*24"
+4 SET ZTIO=""
SET ZTDTH=$HOROLOG
SET ZTREQ="@"
SET ZTSAVE("ZTREQ")=""
SET ZTSAVE("ECJ")=""
DO ^%ZTLOAD
+5 QUIT
+6 ;
PROCESS ;* background job entry point
+1 NEW IEN,COUNT,TXTVAR,BL,ECDT,ECY,I,STA,ECPT
+2 DO F721SRH
+3 SET COUNT=0
SET $PIECE(BL," ",40)=" "
+4 FOR I=1:1
SET TXTVAR=$PIECE($TEXT(MSGTXT+I),";;",2)
if TXTVAR="QUIT"
QUIT
DO LINE(TXTVAR)
+5 DO LINE(" ")
+6 DO LINE(" ")
+7 DO LINE("721 IEN PATIENT IEN DATE/TIME OLD/NEW CPT CODE STA")
+8 DO LINE("------- ----------- --------- ---------------- ---")
+9 SET IEN=0
+10 FOR
SET IEN=$ORDER(^TMP(ECJ,"EC2P24","F721",IEN))
if 'IEN
QUIT
Begin DoDot:1
+11 SET ECX=^TMP(ECJ,"EC2P24","F721",IEN)
SET STA=$PIECE(ECX,U,2)
+12 SET STA=$SELECT(STA:"NC",1:"C")
+13 SET ECPT=$PIECE(ECX,U)_"/"_$SELECT(STA:"",1:$PIECE($GET(^ECH(IEN,"P")),U))
+14 SET Y=$PIECE(ECX,U,5)
XECUTE ^DD("DD")
SET ECDT=Y
+15 SET ECY=$EXTRACT(IEN_BL,1,15)_$EXTRACT($PIECE(ECX,U,4)_BL,1,15)_$EXTRACT(ECDT_BL,1,24)
+16 SET ECY=ECY_$EXTRACT(ECPT_BL,1,20)_STA
+17 DO LINE(ECY)
End DoDot:1
+18 IF $DATA(^TMP(ECJ,"EC2P24","F721"))
Begin DoDot:1
+19 DO LINE(" ")
+20 DO LINE("C - Corrected")
+21 DO LINE("NC - Not Corrected")
End DoDot:1
+22 IF $DATA(^TMP(ECJ,"EC2P24","F725"))
Begin DoDot:1
+23 DO LINE(" ")
+24 DO LINE(" ")
+25 DO LINE(" ")
+26 DO LINE("CPT entries found in EC NATIONAL PROCEDURE FILE #725")
+27 DO LINE("that could not be located in the CPT file #81")
+28 DO LINE(" ")
+29 DO LINE("725 IEN EC NATIONAL CODE CPT CODE")
+30 DO LINE("------- ---------------- --------")
+31 SET IEN=0
FOR
SET IEN=$ORDER(^TMP(ECJ,"EC2P24","F725",IEN))
if 'IEN
QUIT
Begin DoDot:2
+32 SET ECX=^TMP(ECJ,"EC2P24","F725",IEN)
+33 SET ECY=$EXTRACT(IEN_BL,1,15)_$EXTRACT($PIECE(ECX,U,2)_BL,1,36)_" "_$PIECE(ECX,U)
+34 DO LINE(ECY)
End DoDot:2
End DoDot:1
+35 IF '$DATA(^TMP(ECJ,"EC2P24","F721"))
Begin DoDot:1
+36 DO LINE(" ")
+37 DO LINE(" No entries found in EVENT CAPTURE PATIENT file #721 that")
+38 DO LINE(" needs correction.")
+39 DO LINE(" ")
End DoDot:1
+40 KILL ^TMP(ECJ,"EC2P24","F721"),^TMP(ECJ,"EC2P24","F725")
+41 DO MAIL
+42 KILL ^TMP(ECJ,"EC2P24"),ECJ
+43 QUIT
+44 ;
LINE(TEXT) ; Add line to message global
+1 SET COUNT=COUNT+1
SET ^TMP(ECJ,"EC2P24",COUNT)=TEXT
+2 QUIT
+3 ;
MAIL ; Send message
+1 NEW XMDUZ,XMY,XMTEXT,XMSUB
+2 SET XMY(DUZ)=""
SET XMDUZ=.5
+3 SET XMSUB="Event Capture Patient CPT Code Review"
+4 SET XMTEXT="^TMP(ECJ,""EC2P24"","
+5 DO ^XMD
+6 QUIT
FIX721(ECFN,EC) ;Fix bad CPT code entry in file #721
+1 ; Input: ECFN - Event Capture file #721 IEN
+2 ; EC - Zero (0) and "P" nodes in file #721
+3 ;
+4 ; Output: - Returns 1 if fixed and 0 if failed
+5 ;
+6 NEW EC4,ECDX,ECP,ECCPT,ECINP,ECPCE,ECD,NODE,ECDT
+7 SET EC4=$PIECE(EC(0),"^",19)
SET ECDX=$PIECE(EC,"^",2)
SET ECP=$PIECE(EC(0),"^",9)
+8 SET ECCPT=$SELECT(ECP["EC":$PIECE($GET(^EC(725,+ECP,0)),"^",5),1:+ECP)
+9 SET ECINP=$PIECE(EC(0),"^",22)
SET ECD=$PIECE(EC(0),"^",7)
SET NODE=$GET(^ECD(ECD,0))
+10 SET ECPCE="U~"_$SELECT($PIECE(NODE,"^",14)]"":$PIECE(NODE,"^",14),1:"N")
+11 DO NOW^%DTC
SET ECDT=%
+12 DO PCEE^ECBEN2U
+13 QUIT 1
