EC2P6PST ;ALB/GTS - PATCH EC*2.0*6 Post-Init Rtn ; 9/2/97
;;2.0; EVENT CAPTURE ;**6**;8 May 96
;
TEXT ; Install desc.
;; This part of the install walks through Event Capture Screens to check
;; for the existence of pointers to inactivated National Procedures.
;; A mail message is then sent indicating those screens which point
;; to inactivated National Procedures. This message should be forwarded
;; to Event Capture users responsible for management of Event Code
;; Screens.
;;QUIT
;
MSGTXT ; Message intro
;; This message indicates the Event Code Screens which now point to
;; inactive National Procedures. The user should use the Inactivate
;; Event Code Screens [ECDSINAC] option to inactivate the screens
;; indicated and, when appropriate, create new screens which include a
;; respective substitute for the National Procedure which has been
;; inactivated.
;;QUIT
;
POST ; Entry point
;* If 725 converted, write message
I $$GET1^DID(725,"","","PACKAGE REVISION DATA")["EC*2*6" DO
.D MES^XPDUTL(" ")
.D MES^XPDUTL("National Procedure file (#725) previously updated.")
.D MES^XPDUTL(" ")
;* Convert DSS Unit, DSS ID
I $$GET1^DID(725,"","","PACKAGE REVISION DATA")'["EC*2*6" D ENTCNV
Q
;
ENTCNV ; Convert DSS Unit, Associated DSS ID
N I,TXTVAR,ECGOODDA,ECBADDA,ECDARES,ECPTRCHK,ECGOODPT,ECVRRV
D BMES^XPDUTL("Updating the National Procedures file (#725)...")
D MES^XPDUTL(" ")
;
D EN^EC725UPD ;*Update National Procedures
;
;*Get duplicate entry and inactivate both
S ECDARES=$$GETDA("AURAL REHAB STATUS EXAM, 15 MIN","") ;*Get #725 IENs
S ECGOODDA=$P(ECDARES,"^",2)
S ECBADDA=$P(ECDARES,"^",3)
S ECPTRCHK=ECBADDA_";EC(725," ;** Bad variable pointer value
S ECGOODPT=ECGOODDA_";EC(725," ;** Good variable pointer value
;
D SETTMP^EC725CHG ;** Set ^TMP global of procedures inactivated
;
;** Inactivate the duplicate entry in the National Procedure file (725)
I +ECBADDA>0 DO
.S DIE="^EC(725,",DA=ECBADDA,DR="2////^S X=2970831"
.D ^DIE
.K DIE,DA,DR
;
;** Inactivate the original entry in the National Procedure file (725)
I +ECGOODDA>0 DO
.S DIE="^EC(725,",DA=ECGOODDA,DR="2////^S X=2970831"
.D ^DIE
.K DIE,DA,DR
;
D MES^XPDUTL(" "),MES^XPDUTL(" ")
F I=1:1 S TXTVAR=$P($T(TEXT+I),";;",2) Q:TXTVAR="QUIT" DO
.S:TXTVAR="" TXTVAR=" "
.D MES^XPDUTL(TXTVAR)
D F7203INS ;*Report EC Screens pointing to inactive National Procedures
;
S ECVRRV=$$GET1^DID(725,"","","PACKAGE REVISION DATA")
S ECVRRV=ECVRRV_"^EC*2*6"
D PRD^DILFD(725,ECVRRV) ;*Set VRRV node (file #725)
;
D KVARS
Q
;
F7203INS ;* Inspect/Report 720.3
D BMES^XPDUTL("Inspecting EC Event Code Screens file (#720.3)...")
;
;** Inspect Variable Pointers
N ECPTR,ECPROCT,EC01,COUNT
N I,TXTVAR,ECLOC,ECUNIT,ECCAT,ECCATNM,ECPROC,ECSCDA
S COUNT=0
D LINE(" "),LINE(" ")
F I=1:1 S TXTVAR=$P($T(MSGTXT+I),";;",2) Q:TXTVAR="QUIT" DO
.S:TXTVAR="" TXTVAR=" "
.D LINE(TXTVAR)
S (EC01,ECPROCT)=0
F S EC01=$O(^ECJ("B",EC01)) Q:+EC01=0 DO
.S ECPTR=$P(EC01,"-",4)
.S ECSCDA=$O(^ECJ("B",EC01,0))
.I $D(^TMP($J,"EC*2*6 INACTIVE PROC",ECPTR)) DO
..I $P(^ECJ(ECSCDA,0),"^",2)>DT!($P(^ECJ(ECSCDA,0),"^",2)="") DO
...D LINE(" ")
...S ECLOC=$P(EC01,"-",1)
...S ECUNIT=$P(EC01,"-",2)
...S ECCAT=$P(EC01,"-",3)
...S ECLOC=$P($G(^DIC(4,ECLOC,0)),"^",1)
...S ECUNIT=$P($G(^ECD(ECUNIT,0)),"^",1)
...S:+ECCAT'=0 ECCATNM=$P($G(^EC(726,ECCAT,0)),"^",1)
...S:+ECCAT=0 ECCATNM="None"
...S ECPROC=$P($G(^EC(725,$P(ECPTR,";",1),0)),"^",1)
...D LINE(" ")
...D LINE(" The procedure for the following Event Code Screen has been inactivated.")
...D LINE(" Location: "_ECLOC)
...D LINE(" Category: "_ECCATNM)
...D LINE(" DSS Unit: "_ECUNIT)
...D LINE(" Procedure: "_ECPROC)
...S ECPROCT=ECPROCT+1
I ECPROCT=0 DO
.D LINE(" ")
.D LINE("No Event Code Screens were identified as associated with newly inactivated")
.D LINE("National Procedures.")
D MAIL
D MES^XPDUTL(" ")
D MES^XPDUTL(ECPROCT_" Event Code Screens pointing to inactive procedures identified and ")
D MES^XPDUTL("message sent.")
Q
;
KVARS K ^TMP($J,"EC*2*6 INACTIVE PROC")
Q
;
GETDA(ECNAME,ECNUM) ; Get IENs for duplicate entries in 725
; Input:
; ECNAME - The name of the National Procedure to search for a duplicate
; ECNUM - The National Number of the procedure to search
;
; Output:
; ECDAS - Indicates if a duplicate entry was found and the IENs of
; the original and duplicate entry
; Values
; -1 : Entry was not found in National Procedure file
; 0^ien : A single active entry was found (ien returned)
; 1^ien^ien : Duplicate active entries found (iens returned)
;
; Note: If both Name and number are received the Name is searched and
; number ignored
;
N ECDAS,ECNPIEN,ECLPQT
S ECDAS=-1
S (ECLPQT,ECNPIEN)=0
I ECNAME'="" DO
.F S ECNPIEN=$O(^EC(725,"B",ECNAME,ECNPIEN)) Q:+ECNPIEN=0 Q:ECLPQT DO
..I $P(^EC(725,ECNPIEN,0),"^",3)>DT!($P(^EC(725,ECNPIEN,0),"^",3)="") DO
...I +ECDAS=0 S ECDAS="1^"_$P(ECDAS,"^",2)_"^"_ECNPIEN S ECLPQT=1
...S:ECDAS=-1 ECDAS="0^"_ECNPIEN
I ECNUM'="",ECNAME="" DO
.F S ECNPIEN=$O(^EC(725,"D",ECNUM,ECNPIEN)) Q:+ECNPIEN=0 Q:ECLPQT DO
..I $P(^EC(725,ECNPIEN,0),"^",3)>DT!($P(^EC(725,ECNPIEN,0),"^",3)="") DO
...I +ECDAS=0 S ECDAS="1^"_$P(ECDAS,"^",2)_"^"_ECNPIEN S ECLPQT=1
...S:ECDAS=-1 ECDAS="0^"_ECNPIEN
Q ECDAS
;
MAIL ; Send message
N DIFROM
S XMY(DUZ)="",XMDUZ=.5
S XMSUB="Event Code Screens to review"
S XMTEXT="^TMP(""EC V2.0 P6 INSTALL MSG"","_$J_","
D ^XMD
K XMDUZ,XMY,XMTEXT,XMSUB
K ^TMP("EC V2.0 P6 INSTALL MSG",$J)
Q
;
LINE(TEXT) ; Add line to message global
S COUNT=COUNT+1,^TMP("EC V2.0 P6 INSTALL MSG",$J,COUNT)=TEXT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEC2P6PST 5857 printed Apr 09, 2024@21:04:03 Page 2
EC2P6PST ;ALB/GTS - PATCH EC*2.0*6 Post-Init Rtn ; 9/2/97
+1 ;;2.0; EVENT CAPTURE ;**6**;8 May 96
+2 ;
TEXT ; Install desc.
+1 ;; This part of the install walks through Event Capture Screens to check
+2 ;; for the existence of pointers to inactivated National Procedures.
+3 ;; A mail message is then sent indicating those screens which point
+4 ;; to inactivated National Procedures. This message should be forwarded
+5 ;; to Event Capture users responsible for management of Event Code
+6 ;; Screens.
+7 ;;QUIT
+8 ;
MSGTXT ; Message intro
+1 ;; This message indicates the Event Code Screens which now point to
+2 ;; inactive National Procedures. The user should use the Inactivate
+3 ;; Event Code Screens [ECDSINAC] option to inactivate the screens
+4 ;; indicated and, when appropriate, create new screens which include a
+5 ;; respective substitute for the National Procedure which has been
+6 ;; inactivated.
+7 ;;QUIT
+8 ;
POST ; Entry point
+1 ;* If 725 converted, write message
+2 IF $$GET1^DID(725,"","","PACKAGE REVISION DATA")["EC*2*6"
Begin DoDot:1
+3 DO MES^XPDUTL(" ")
+4 DO MES^XPDUTL("National Procedure file (#725) previously updated.")
+5 DO MES^XPDUTL(" ")
End DoDot:1
+6 ;* Convert DSS Unit, DSS ID
+7 IF $$GET1^DID(725,"","","PACKAGE REVISION DATA")'["EC*2*6"
DO ENTCNV
+8 QUIT
+9 ;
ENTCNV ; Convert DSS Unit, Associated DSS ID
+1 NEW I,TXTVAR,ECGOODDA,ECBADDA,ECDARES,ECPTRCHK,ECGOODPT,ECVRRV
+2 DO BMES^XPDUTL("Updating the National Procedures file (#725)...")
+3 DO MES^XPDUTL(" ")
+4 ;
+5 ;*Update National Procedures
DO EN^EC725UPD
+6 ;
+7 ;*Get duplicate entry and inactivate both
+8 ;*Get #725 IENs
SET ECDARES=$$GETDA("AURAL REHAB STATUS EXAM, 15 MIN","")
+9 SET ECGOODDA=$PIECE(ECDARES,"^",2)
+10 SET ECBADDA=$PIECE(ECDARES,"^",3)
+11 ;** Bad variable pointer value
SET ECPTRCHK=ECBADDA_";EC(725,"
+12 ;** Good variable pointer value
SET ECGOODPT=ECGOODDA_";EC(725,"
+13 ;
+14 ;** Set ^TMP global of procedures inactivated
DO SETTMP^EC725CHG
+15 ;
+16 ;** Inactivate the duplicate entry in the National Procedure file (725)
+17 IF +ECBADDA>0
Begin DoDot:1
+18 SET DIE="^EC(725,"
SET DA=ECBADDA
SET DR="2////^S X=2970831"
+19 DO ^DIE
+20 KILL DIE,DA,DR
End DoDot:1
+21 ;
+22 ;** Inactivate the original entry in the National Procedure file (725)
+23 IF +ECGOODDA>0
Begin DoDot:1
+24 SET DIE="^EC(725,"
SET DA=ECGOODDA
SET DR="2////^S X=2970831"
+25 DO ^DIE
+26 KILL DIE,DA,DR
End DoDot:1
+27 ;
+28 DO MES^XPDUTL(" ")
DO MES^XPDUTL(" ")
+29 FOR I=1:1
SET TXTVAR=$PIECE($TEXT(TEXT+I),";;",2)
if TXTVAR="QUIT"
QUIT
Begin DoDot:1
+30 if TXTVAR=""
SET TXTVAR=" "
+31 DO MES^XPDUTL(TXTVAR)
End DoDot:1
+32 ;*Report EC Screens pointing to inactive National Procedures
DO F7203INS
+33 ;
+34 SET ECVRRV=$$GET1^DID(725,"","","PACKAGE REVISION DATA")
+35 SET ECVRRV=ECVRRV_"^EC*2*6"
+36 ;*Set VRRV node (file #725)
DO PRD^DILFD(725,ECVRRV)
+37 ;
+38 DO KVARS
+39 QUIT
+40 ;
F7203INS ;* Inspect/Report 720.3
+1 DO BMES^XPDUTL("Inspecting EC Event Code Screens file (#720.3)...")
+2 ;
+3 ;** Inspect Variable Pointers
+4 NEW ECPTR,ECPROCT,EC01,COUNT
+5 NEW I,TXTVAR,ECLOC,ECUNIT,ECCAT,ECCATNM,ECPROC,ECSCDA
+6 SET COUNT=0
+7 DO LINE(" ")
DO LINE(" ")
+8 FOR I=1:1
SET TXTVAR=$PIECE($TEXT(MSGTXT+I),";;",2)
if TXTVAR="QUIT"
QUIT
Begin DoDot:1
+9 if TXTVAR=""
SET TXTVAR=" "
+10 DO LINE(TXTVAR)
End DoDot:1
+11 SET (EC01,ECPROCT)=0
+12 FOR
SET EC01=$ORDER(^ECJ("B",EC01))
if +EC01=0
QUIT
Begin DoDot:1
+13 SET ECPTR=$PIECE(EC01,"-",4)
+14 SET ECSCDA=$ORDER(^ECJ("B",EC01,0))
+15 IF $DATA(^TMP($JOB,"EC*2*6 INACTIVE PROC",ECPTR))
Begin DoDot:2
+16 IF $PIECE(^ECJ(ECSCDA,0),"^",2)>DT!($PIECE(^ECJ(ECSCDA,0),"^",2)="")
Begin DoDot:3
+17 DO LINE(" ")
+18 SET ECLOC=$PIECE(EC01,"-",1)
+19 SET ECUNIT=$PIECE(EC01,"-",2)
+20 SET ECCAT=$PIECE(EC01,"-",3)
+21 SET ECLOC=$PIECE($GET(^DIC(4,ECLOC,0)),"^",1)
+22 SET ECUNIT=$PIECE($GET(^ECD(ECUNIT,0)),"^",1)
+23 if +ECCAT'=0
SET ECCATNM=$PIECE($GET(^EC(726,ECCAT,0)),"^",1)
+24 if +ECCAT=0
SET ECCATNM="None"
+25 SET ECPROC=$PIECE($GET(^EC(725,$PIECE(ECPTR,";",1),0)),"^",1)
+26 DO LINE(" ")
+27 DO LINE(" The procedure for the following Event Code Screen has been inactivated.")
+28 DO LINE(" Location: "_ECLOC)
+29 DO LINE(" Category: "_ECCATNM)
+30 DO LINE(" DSS Unit: "_ECUNIT)
+31 DO LINE(" Procedure: "_ECPROC)
+32 SET ECPROCT=ECPROCT+1
End DoDot:3
End DoDot:2
End DoDot:1
+33 IF ECPROCT=0
Begin DoDot:1
+34 DO LINE(" ")
+35 DO LINE("No Event Code Screens were identified as associated with newly inactivated")
+36 DO LINE("National Procedures.")
End DoDot:1
+37 DO MAIL
+38 DO MES^XPDUTL(" ")
+39 DO MES^XPDUTL(ECPROCT_" Event Code Screens pointing to inactive procedures identified and ")
+40 DO MES^XPDUTL("message sent.")
+41 QUIT
+42 ;
KVARS KILL ^TMP($JOB,"EC*2*6 INACTIVE PROC")
+1 QUIT
+2 ;
GETDA(ECNAME,ECNUM) ; Get IENs for duplicate entries in 725
+1 ; Input:
+2 ; ECNAME - The name of the National Procedure to search for a duplicate
+3 ; ECNUM - The National Number of the procedure to search
+4 ;
+5 ; Output:
+6 ; ECDAS - Indicates if a duplicate entry was found and the IENs of
+7 ; the original and duplicate entry
+8 ; Values
+9 ; -1 : Entry was not found in National Procedure file
+10 ; 0^ien : A single active entry was found (ien returned)
+11 ; 1^ien^ien : Duplicate active entries found (iens returned)
+12 ;
+13 ; Note: If both Name and number are received the Name is searched and
+14 ; number ignored
+15 ;
+16 NEW ECDAS,ECNPIEN,ECLPQT
+17 SET ECDAS=-1
+18 SET (ECLPQT,ECNPIEN)=0
+19 IF ECNAME'=""
Begin DoDot:1
+20 FOR
SET ECNPIEN=$ORDER(^EC(725,"B",ECNAME,ECNPIEN))
if +ECNPIEN=0
QUIT
if ECLPQT
QUIT
Begin DoDot:2
+21 IF $PIECE(^EC(725,ECNPIEN,0),"^",3)>DT!($PIECE(^EC(725,ECNPIEN,0),"^",3)="")
Begin DoDot:3
+22 IF +ECDAS=0
SET ECDAS="1^"_$PIECE(ECDAS,"^",2)_"^"_ECNPIEN
SET ECLPQT=1
+23 if ECDAS=-1
SET ECDAS="0^"_ECNPIEN
End DoDot:3
End DoDot:2
End DoDot:1
+24 IF ECNUM'=""
IF ECNAME=""
Begin DoDot:1
+25 FOR
SET ECNPIEN=$ORDER(^EC(725,"D",ECNUM,ECNPIEN))
if +ECNPIEN=0
QUIT
if ECLPQT
QUIT
Begin DoDot:2
+26 IF $PIECE(^EC(725,ECNPIEN,0),"^",3)>DT!($PIECE(^EC(725,ECNPIEN,0),"^",3)="")
Begin DoDot:3
+27 IF +ECDAS=0
SET ECDAS="1^"_$PIECE(ECDAS,"^",2)_"^"_ECNPIEN
SET ECLPQT=1
+28 if ECDAS=-1
SET ECDAS="0^"_ECNPIEN
End DoDot:3
End DoDot:2
End DoDot:1
+29 QUIT ECDAS
+30 ;
MAIL ; Send message
+1 NEW DIFROM
+2 SET XMY(DUZ)=""
SET XMDUZ=.5
+3 SET XMSUB="Event Code Screens to review"
+4 SET XMTEXT="^TMP(""EC V2.0 P6 INSTALL MSG"","_$JOB_","
+5 DO ^XMD
+6 KILL XMDUZ,XMY,XMTEXT,XMSUB
+7 KILL ^TMP("EC V2.0 P6 INSTALL MSG",$JOB)
+8 QUIT
+9 ;
LINE(TEXT) ; Add line to message global
+1 SET COUNT=COUNT+1
SET ^TMP("EC V2.0 P6 INSTALL MSG",$JOB,COUNT)=TEXT
+2 QUIT
