- 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 Feb 18, 2025@23:22:31 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