ECX3P7PT ;ALB/JAP - PATCH ECX*3*7 Post-Init Rtn ; May 6, 1998
;;3.0;DSS EXTRACTS;**7**;Dec 22, 1997
;
POST ;Entry point
N ECXDA
D INTRO
;
;if new entries (iens>112) already added, display message and quit
S ECXDA=$O(^ECX(728.441,999),-1)
I $D(^ECX(728.441,113,0)),$P(^(0),U,1)="AAAA" D Q
.D MES^XPDUTL(" ")
.D MES^XPDUTL(" It appears that patch ECX*3*7 was previously installed.")
.D MES^XPDUTL(" ")
.D MES^XPDUTL(" If you wish to repeat the installation of patch ECX*3*7,")
.D MES^XPDUTL(" then run CLEAN^ECX3P7P1 first -- that will delete any")
.D MES^XPDUTL(" entries from ECX*3*7 previously added.")
.D MES^XPDUTL(" ")
;
;check contents of entry #113
I ($D(^ECX(728.441,113,0))&($P($G(^(0)),U,1)'="AAAA"))!(ECXDA'=112) D Q
.D MES^XPDUTL(" ")
.D MES^XPDUTL(" It appears that you may have a problem with File #728.441.")
.D MES^XPDUTL(" ")
.D MES^XPDUTL(" Perform a FileMan print of the entire file which shows")
.D MES^XPDUTL(" the internal entry number and #.01 field of each record.")
.D MES^XPDUTL(" ")
.D MES^XPDUTL(" Call Customer Support for further assistance.")
.D MES^XPDUTL(" Have the FileMan printout at hand when you call.")
.D MES^XPDUTL(" ")
;
;add new entries
I '$D(^EC(728.441,113)),ECXDA=112 D ADD^ECX3P7P1
Q
;
INTRO ; Message intro
;;
;; The purpose of Patch ECX*3*7 is to add new entries to the
;; NATIONAL CLINIC File (#728.441). A total of 158 new
;; entries will be made.
;;
;;
;;QUIT
;
N TXTVAR
F I=1:1 S TXTVAR=$P($T(INTRO+I),";;",2) Q:TXTVAR="QUIT" DO
.D MES^XPDUTL(TXTVAR)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECX3P7PT 1609 printed Dec 13, 2024@01:50:46 Page 2
ECX3P7PT ;ALB/JAP - PATCH ECX*3*7 Post-Init Rtn ; May 6, 1998
+1 ;;3.0;DSS EXTRACTS;**7**;Dec 22, 1997
+2 ;
POST ;Entry point
+1 NEW ECXDA
+2 DO INTRO
+3 ;
+4 ;if new entries (iens>112) already added, display message and quit
+5 SET ECXDA=$ORDER(^ECX(728.441,999),-1)
+6 IF $DATA(^ECX(728.441,113,0))
IF $PIECE(^(0),U,1)="AAAA"
Begin DoDot:1
+7 DO MES^XPDUTL(" ")
+8 DO MES^XPDUTL(" It appears that patch ECX*3*7 was previously installed.")
+9 DO MES^XPDUTL(" ")
+10 DO MES^XPDUTL(" If you wish to repeat the installation of patch ECX*3*7,")
+11 DO MES^XPDUTL(" then run CLEAN^ECX3P7P1 first -- that will delete any")
+12 DO MES^XPDUTL(" entries from ECX*3*7 previously added.")
+13 DO MES^XPDUTL(" ")
End DoDot:1
QUIT
+14 ;
+15 ;check contents of entry #113
+16 IF ($DATA(^ECX(728.441,113,0))&($PIECE($GET(^(0)),U,1)'="AAAA"))!(ECXDA'=112)
Begin DoDot:1
+17 DO MES^XPDUTL(" ")
+18 DO MES^XPDUTL(" It appears that you may have a problem with File #728.441.")
+19 DO MES^XPDUTL(" ")
+20 DO MES^XPDUTL(" Perform a FileMan print of the entire file which shows")
+21 DO MES^XPDUTL(" the internal entry number and #.01 field of each record.")
+22 DO MES^XPDUTL(" ")
+23 DO MES^XPDUTL(" Call Customer Support for further assistance.")
+24 DO MES^XPDUTL(" Have the FileMan printout at hand when you call.")
+25 DO MES^XPDUTL(" ")
End DoDot:1
QUIT
+26 ;
+27 ;add new entries
+28 IF '$DATA(^EC(728.441,113))
IF ECXDA=112
DO ADD^ECX3P7P1
+29 QUIT
+30 ;
INTRO ; Message intro
+1 ;;
+2 ;; The purpose of Patch ECX*3*7 is to add new entries to the
+3 ;; NATIONAL CLINIC File (#728.441). A total of 158 new
+4 ;; entries will be made.
+5 ;;
+6 ;;
+7 ;;QUIT
+8 ;
+9 NEW TXTVAR
+10 FOR I=1:1
SET TXTVAR=$PIECE($TEXT(INTRO+I),";;",2)
if TXTVAR="QUIT"
QUIT
Begin DoDot:1
+11 DO MES^XPDUTL(TXTVAR)
End DoDot:1
+12 QUIT
