ECX3P7PT.m

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 ---ECX3P7PT   1609     printed  Apr 09, 2024@20:57: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