- 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 Apr 23, 2025@18:05:15 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
