APSP7PRE.m

APSP7PRE ;IHS/CIA/PLS - Pre-Init routine for APSP v7.0;30-Apr-2004 11:24;PLS

 ;;7.0;IHS PHARMACY MODIFICATIONS;;01/28/2003

 ;

PRE ; EP

 N LP

 ; Rename Help Frames that begin with PSOZ

 D RENHLPF("PSOZ","APSP")

 F LP="PSO ARCHIVE","PSOL MANAGER","PSO PROVIDER ADD" D

 .D FIXOMSG(LP)

 D DELDD

 Q

 ;

RENHLPF(FROM,TO) ;

 N HNAM,HIEN,NNAM

 S HNAM=FROM

 F  S HNAM=$O(^DIC(9.2,"B",HNAM)) Q:HNAM=""!($E(HNAM,1,$L(FROM))'=FROM)  D

 .S HIEN=0 F  S HIEN=$O(^DIC(9.2,"B",HNAM,HIEN)) Q:'HIEN  D

 ..S NNAM=TO_$E(HNAM,$L(FROM)+1,$L(HNAM))

 ..D FIXNM(HIEN,NNAM)

 Q

 ;

FIXNM(HIEN,NAM) ; Call FileMan to change name of Help Frame

 N FDA,ERR

 S FDA(9.2,HIEN_",",.01)=NAM

 D FILE^DIE("K","FDA","ERR")

 I '$G(ERR) D

 .D MES("Help Frame: "_NAM_" has been saved.")

 E  D MES("Unable to update the "_NAM_" help frame.")

 Q

 ;

DELDD ; Delete DD

 N DIU

 F DIU=9009033 D

 .S DIU(0)=""

 .D EN^DIU2

 Q

 ; Fix Out of Order Message and lock with APSP Key

FIXOMSG(OPT) ;

 N IEN,VAL,FDA,KEY

 S IEN=$$FIND1^DIC(19,,"X",OPT)

 S KEY=$$FIND1^DIC(19.1,,"X","APSP")

 I IEN D

 .S VAL="Not used by IHS Pharmacies."

 .S FDA(19,IEN_",",2)=VAL

 .S:KEY FDA(19,IEN_",",3)=KEY

 .D FILE^DIE("K","FDA")

 Q

 ; Display message in MSG and optionally set quit flag to QUIT

MES(MSG,QUIT) ;

 D BMES^XPDUTL("  "_$G(MSG))

 S:$G(QUIT) XPDQUIT=QUIT

 Q

APSP7PRE  ;IHS/CIA/PLS - Pre-Init routine for APSP v7.0;30-Apr-2004 11:24;PLS

 +1       ;;7.0;IHS PHARMACY MODIFICATIONS;;01/28/2003

 +2       ;

PRE       ; EP

 +1        NEW LP

 +2       ; Rename Help Frames that begin with PSOZ

 +3        DO RENHLPF("PSOZ","APSP")

 +4        FOR LP="PSO ARCHIVE","PSOL MANAGER","PSO PROVIDER ADD"

               Begin DoDot:1

 +5                DO FIXOMSG(LP)

               End DoDot:1

 +6        DO DELDD

 +7        QUIT 

 +8       ;

RENHLPF(FROM,TO) ;

 +1        NEW HNAM,HIEN,NNAM

 +2        SET HNAM=FROM

 +3        FOR 

               SET HNAM=$ORDER(^DIC(9.2,"B",HNAM))

               IF HNAM=""!($EXTRACT(HNAM,1,$LENGTH(FROM))'=FROM)

                   QUIT 

               Begin DoDot:1

 +4                SET HIEN=0

                   FOR 

                       SET HIEN=$ORDER(^DIC(9.2,"B",HNAM,HIEN))

                       IF 'HIEN

                           QUIT 

                       Begin DoDot:2

 +5                        SET NNAM=TO_$EXTRACT(HNAM,$LENGTH(FROM)+1,$LENGTH(HNAM))

 +6                        DO FIXNM(HIEN,NNAM)

                       End DoDot:2

               End DoDot:1

 +7        QUIT 

 +8       ;

FIXNM(HIEN,NAM) ; Call FileMan to change name of Help Frame

 +1        NEW FDA,ERR

 +2        SET FDA(9.2,HIEN_",",.01)=NAM

 +3        DO FILE^DIE("K","FDA","ERR")

 +4        IF '$GET(ERR)

               Begin DoDot:1

 +5                DO MES("Help Frame: "_NAM_" has been saved.")

               End DoDot:1

 +6       IF '$TEST

               DO MES("Unable to update the "_NAM_" help frame.")

 +7        QUIT 

 +8       ;

DELDD     ; Delete DD

 +1        NEW DIU

 +2        FOR DIU=9009033

               Begin DoDot:1

 +3                SET DIU(0)=""

 +4                DO EN^DIU2

               End DoDot:1

 +5        QUIT 

 +6       ; Fix Out of Order Message and lock with APSP Key

FIXOMSG(OPT) ;

 +1        NEW IEN,VAL,FDA,KEY

 +2        SET IEN=$$FIND1^DIC(19,,"X",OPT)

 +3        SET KEY=$$FIND1^DIC(19.1,,"X","APSP")

 +4        IF IEN

               Begin DoDot:1

 +5                SET VAL="Not used by IHS Pharmacies."

 +6                SET FDA(19,IEN_",",2)=VAL

 +7                IF KEY

                       SET FDA(19,IEN_",",3)=KEY

 +8                DO FILE^DIE("K","FDA")

               End DoDot:1

 +9        QUIT 

 +10      ; Display message in MSG and optionally set quit flag to QUIT

MES(MSG,QUIT) ;

 +1        DO BMES^XPDUTL("  "_$GET(MSG))

 +2        IF $GET(QUIT)

               SET XPDQUIT=QUIT

 +3        QUIT