AG7P1A.m

AG7P1A ;IHS/ASDST/GTH - Patient Registration 7.0 Patch 1 CONT. ;   [ 06/17/2003  10:49 AM ]

 ;;7.0;IHS PATIENT REGISTRATION;**1**;JUN 13, 2003

 ;

 ; IHS/SD/EFG  AG*7*1  5/8/2003

 ;

PRE ;EP - From KIDS.

 Q

 ;

POST ;EP - From KIDS.

 ;

 D BMES^XPDUTL("Beginning post-install routine (POST^AG7P1A)."),TS

 ;

 D ^AGSETPRT

 ;

 I $$INSTALLD^AG7P1("AG*7.0*1")  D

 . D TS,BMES^XPDUTL("Delivering AG*7.0*1 install message to select users...")

 . D MAIL

 . D BMES^XPDUTL("Post-install routine is complete."),TS

 ;

 Q:$$INSTALLD^AG7P1("AG*7.0*1")

 ;

 D TS,OPTRES("AGMENU")

 ;

 D TS,BMES^XPDUTL("Delivering AG*7.0*1 install message to select users...")

 D MAIL

 ;

 D BMES^XPDUTL("Post-install routine is complete."),TS

 Q

 ;

MAIL ; Send install mail message.

 NEW DIFROM,XMSUB,XMDUZ,XMTEXT,XMY

 KILL ^TMP("AG7P1MS",$J)

 S ^TMP("AG7P1MS",$J,1)=" --- AG v 7.0, has been installed into this uci ---"

 S %=0

 F  S %=$O(^XTMP("XPDI",XPDA,"BLD",XPDBLD,1,%)) Q:'%   S ^TMP("AG7P1MS",$J,(%+1))=" "_^(%,0)

 S XMSUB=$P($P($T(+1),";",2)," ",3,99),XMDUZ=$S($G(DUZ):DUZ,1:.5),XMTEXT="^TMP(""AG7P1MS"",$J,",XMY(1)="",XMY(DUZ)=""

 F %="AGZMENU","XUMGR","XUPROG","XUPROGMODE" D SINGLE(%)

 D ^XMD

 KILL ^TMP("AG7P1MS",$J)

 Q

 ;

SINGLE(K) ;EP - Get holders of a single key K.

 NEW Y

 S Y=0

 Q:'$D(^XUSEC(K))

 F  S Y=$O(^XUSEC(K,Y)) Q:'Y  S XMY(Y)=""

 Q

 ;

OPTRES(AGM) ;

 D BMES^XPDUTL("Restoring '"_AGM_"' option to PRE-install configuration...")

 NEW AG,AGI

 I '$D(^XTMP("AG7P1",7.1,"OPTSAV",AGM)) D BMES^XPDUTL("FAILED.  Option '"_AGM_"' was not previously saved.") Q

 S AG=0

 F  S AG=$O(^XTMP("AG7P1",7.1,"OPTSAV",AGM,AG)) Q:'AG  S AGI=^(AG) I '$$ADD^XPDMENU(AGM,$P(AGI,U,1),$P(AGI,U,2),$P(AGI,U,3)) D BMES^XPDUTL("....FAILED to re-atch "_$P(AGI,U,1)_" to "_AGM_".")

 D BMES^XPDUTL("Attaching ""RHI1"" option to the Registration Reports menu ""RPT"".")

 I $$ADD^XPDMENU("AGREPORTS","AGRHI1","RHI1",20) D BMES^XPDUTL("....successfully atch'd.") I 1

 E  D BMES^XPDUTL("....Attachment *FAILED*.")

 ;

 Q

 ;

TS D MES^XPDUTL($$HTE^XLFDT($H)) Q

 ;

AG7P1A    ;IHS/ASDST/GTH - Patient Registration 7.0 Patch 1 CONT. ;   [ 06/17/2003  10:49 AM ]

 +1       ;;7.0;IHS PATIENT REGISTRATION;**1**;JUN 13, 2003

 +2       ;

 +3       ; IHS/SD/EFG  AG*7*1  5/8/2003

 +4       ;

PRE       ;EP - From KIDS.

 +1        QUIT 

 +2       ;

POST      ;EP - From KIDS.

 +1       ;

 +2        DO BMES^XPDUTL("Beginning post-install routine (POST^AG7P1A).")

           DO TS

 +3       ;

 +4        DO ^AGSETPRT

 +5       ;

 +6        IF $$INSTALLD^AG7P1("AG*7.0*1")

               Begin DoDot:1

 +7                DO TS

                   DO BMES^XPDUTL("Delivering AG*7.0*1 install message to select users...")

 +8                DO MAIL

 +9                DO BMES^XPDUTL("Post-install routine is complete.")

                   DO TS

               End DoDot:1

 +10      ;

 +11       IF $$INSTALLD^AG7P1("AG*7.0*1")

               QUIT 

 +12      ;

 +13       DO TS

           DO OPTRES("AGMENU")

 +14      ;

 +15       DO TS

           DO BMES^XPDUTL("Delivering AG*7.0*1 install message to select users...")

 +16       DO MAIL

 +17      ;

 +18       DO BMES^XPDUTL("Post-install routine is complete.")

           DO TS

 +19       QUIT 

 +20      ;

MAIL      ; Send install mail message.

 +1        NEW DIFROM,XMSUB,XMDUZ,XMTEXT,XMY

 +2        KILL ^TMP("AG7P1MS",$JOB)

 +3        SET ^TMP("AG7P1MS",$JOB,1)=" --- AG v 7.0, has been installed into this uci ---"

 +4        SET %=0

 +5        FOR 

               SET %=$ORDER(^XTMP("XPDI",XPDA,"BLD",XPDBLD,1,%))

               IF '%

                   QUIT 

               SET ^TMP("AG7P1MS",$JOB,(%+1))=" "_^(%,0)

 +6        SET XMSUB=$PIECE($PIECE($TEXT(+1),";",2)," ",3,99)

           SET XMDUZ=$SELECT($GET(DUZ):DUZ,1:.5)

           SET XMTEXT="^TMP(""AG7P1MS"",$J,"

           SET XMY(1)=""

           SET XMY(DUZ)=""

 +7        FOR %="AGZMENU","XUMGR","XUPROG","XUPROGMODE"

               DO SINGLE(%)

 +8        DO ^XMD

 +9        KILL ^TMP("AG7P1MS",$JOB)

 +10       QUIT 

 +11      ;

SINGLE(K) ;EP - Get holders of a single key K.

 +1        NEW Y

 +2        SET Y=0

 +3        IF '$DATA(^XUSEC(K))

               QUIT 

 +4        FOR 

               SET Y=$ORDER(^XUSEC(K,Y))

               IF 'Y

                   QUIT 

               SET XMY(Y)=""

 +5        QUIT 

 +6       ;

OPTRES(AGM) ;

 +1        DO BMES^XPDUTL("Restoring '"_AGM_"' option to PRE-install configuration...")

 +2        NEW AG,AGI

 +3        IF '$DATA(^XTMP("AG7P1",7.1,"OPTSAV",AGM))

               DO BMES^XPDUTL("FAILED.  Option '"_AGM_"' was not previously saved.")

               QUIT 

 +4        SET AG=0

 +5        FOR 

               SET AG=$ORDER(^XTMP("AG7P1",7.1,"OPTSAV",AGM,AG))

               IF 'AG

                   QUIT 

               SET AGI=^(AG)

               IF '$$ADD^XPDMENU(AGM,$PIECE(AGI,U,1),$PIECE(AGI,U,2),$PIECE(AGI,U,3))

                   DO BMES^XPDUTL("....FAILED to re-atch "_$PIECE(AGI,U,1)_" to "_AGM_".")

 +6        DO BMES^XPDUTL("Attaching ""RHI1"" option to the Registration Reports menu ""RPT"".")

 +7        IF $$ADD^XPDMENU("AGREPORTS","AGRHI1","RHI1",20)

               DO BMES^XPDUTL("....successfully atch'd.")

               IF 1

 +8       IF '$TEST

               DO BMES^XPDUTL("....Attachment *FAILED*.")

 +9       ;

 +10       QUIT 

 +11      ;

TS         DO MES^XPDUTL($$HTE^XLFDT($HOROLOG))

           QUIT 

 +1       ;