PSO467PO.m

PSO467PO ;ALB/BWF - patch 467 post-install ; 8/17/2016 1:14pm

 ;;7.0;OUTPATIENT PHARMACY;**467**;DEC 1997;Build 153

 ;

 ; ICR #4677 = $$CREATE^XUSAP (API for Application Proxy)

 ; ICR #10141 = BMES^XPDUTL & MES^XPDUTL

 ; 

 ; Application Proxy name = "PSOAPPLICATIONPROXY,PSO"

 ; Secondary Menu Option name = "PSO WEB SERVICES OPTION"

 ;

RUNALL ; Entry point in the (Patch - PSO*7.0*467)

 D BMSG("Starting Post-Init")

 D PROXY

 D MSG("Post-Init Complete")

 D APRIND

 D WSERV

 D PAYMIG

 D INDEX

 Q

 ;

PROXY ; Create an Application Proxy for PSO application

 N X

 S X=$$CREATE^XUSAP("PSOAPPLICATIONPROXY,PSO","","PSO WEB SERVICES OPTION")

 ;

 I +X=0 D  Q

 .D BMSG("   Application Proxy User - 'PSOAPPLICATIONPROXY,PSO'")

 .D MSG("   already exists in the NEW PERSON file (#200)"),MSG("")

 ;

 I +X=-1 D  Q

 .D BMSG("   Application Proxy User - 'PSOAPPLICATIONPROXY,PSO'")

 .D MSG("   Unsuccessful; could not create Application Proxy User")

 .D MSG("   OR error in call to UPDATE^DIE)"),MSG("")

 ;

 D BMSG("   *****************************************************************")

 D MSG("   ** Application Proxy User - 'PSOAPPLICATIONPROXY,PSO' = created **")

 D MSG("   ** Secondary Menu Option - 'PSO WEB SERVICES OPTION' = linked   **")

 D MSG("   **                         to the Application Proxy.            **")

 D MSG("   ******************************************************************")

 D MSG("")

 Q

 ;

 ; A message is also recorded in INSTALL file

 ; (#9.7) entry for the installation.

 ;

 ; Output a message.

MSG(MSG) ; Integration Agreement #10141

 D MES^XPDUTL(MSG)

 Q

 ;

 ; Output a message with a blank line added.

BMSG(MSG) ; Integration Agreement #10141

 D BMES^XPDUTL(MSG)

 Q

 ; create the APR index

APRIND ;

 N DIK,DA

 S DIK="^PSDRUG(",DIK(1)="22^APR"

 D ENALL^DIK

 Q

 ; create web server and service

WSERV ;

 N FDA,WSIEN,NWSIEN,WSERVIEN,WSRVIEN

 ; if the web service already exists, this has been configured

 I $$FIND1^DIC(18.02,,"B","PSO ERX WEB SERVICE") Q

 ; set up the web service

 S FDA(18.02,"+1,",.01)="PSO ERX WEB SERVICE"

 S FDA(18.02,"+1,",.02)=2

 S FDA(18.02,"+1,",200)="/INB-ERX/"

 D UPDATE^DIE(,"FDA","WSIEN") K FDA

 S NWSIEN=$O(WSIEN(0)),NWSIEN=$G(WSIEN(NWSIEN)) Q:'NWSIEN

 S FDA(18.12,"+1,",.01)="PSO WEB SERVER"

 S FDA(18.12,"+1,",.03)=80

 ;S FDA(18.12,"+1,",.04)="vaauserxappdev1.aac.domain.ext"

 S FDA(18.12,"+1,",.06)=1

 S FDA(18.12,"+1,",.07)=30

 S FDA(18.12,"+1,",1.01)=0

 D UPDATE^DIE(,"FDA","WSERVIEN") K FDA

 S WSRVIEN=$O(WSERVIEN(0)) Q:'WSRVIEN

 S WSRVIEN=$G(WSERVIEN(WSRVIEN)) Q:'WSRVIEN

 S FDA(18.121,"+1,"_WSRVIEN_",",.01)=NWSIEN

 S FDA(18.121,"+1,"_WSRVIEN_",",.06)=1

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

 Q

CALL ;

 N I,X

 F I=52.46,52.47,52.48,52.49 D

 .S X=0 F  S X=$O(^PS(I,X)) Q:'X  D

 ..S FDA(I,X_",",.01)="@"

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

 Q

 ; migrate payer fields for new cardholder and sequence structure

PAYMIG ;

 N ERXIEN,BFCIEN,CHID,BIENS,FDA,DA,DR

 ; no need to reindex if there is no data

 I '$O(^PS(52.49,0)) Q

 S ERXIEN=0 F  S ERXIEN=$O(^PS(52.49,ERXIEN)) Q:'ERXIEN  D

 .; do not process entries that have already been converted

 .Q:$$GET1^DIQ(52.49,ERXIEN,44,"I")=1

 .S BFCIEN=0 F  S BFCIEN=$O(^PS(52.49,ERXIEN,18,BFCIEN)) Q:'BFCIEN  D

 ..S BIENS=BFCIEN_","_ERXIEN_","

 ..S CHID=$$GET1^DIQ(52.4918,BIENS,.01,"E")

 ..; move the cardholder id to field 7 and change the .01 field to the IEN (as a sequence)

 ..S FDA(52.4918,BIENS,7)=CHID

 ..S FDA(52.4918,BIENS,.01)=BFCIEN

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

 .; set the conversion flag so this conversion will not run again for this entry.

 .S DIE="^PS(52.49,",DA=ERXIEN,DR="44///1" D ^DIE K DIE

 Q

 ; reindex all files

INDEX ;

 N DIK,FILE

 ; no need to reindex if there is no data

 I '$O(^PS(52.49,0)) Q

 F FILE="52.45","52.46","52.47","52.48","52.49" D

 .S DIK="^PS("_FILE_"," D IXALL2^DIK,IXALL^DIK

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSO467PO   3925     printed  Feb 18, 2025@23:49:18                                                                                                                                                                                                    Page 2

PSO467PO  ;ALB/BWF - patch 467 post-install ; 8/17/2016 1:14pm

 +1       ;;7.0;OUTPATIENT PHARMACY;**467**;DEC 1997;Build 153

 +2       ;

 +3       ; ICR #4677 = $$CREATE^XUSAP (API for Application Proxy)

 +4       ; ICR #10141 = BMES^XPDUTL & MES^XPDUTL

 +5       ; 

 +6       ; Application Proxy name = "PSOAPPLICATIONPROXY,PSO"

 +7       ; Secondary Menu Option name = "PSO WEB SERVICES OPTION"

 +8       ;

RUNALL    ; Entry point in the (Patch - PSO*7.0*467)

 +1        DO BMSG("Starting Post-Init")

 +2        DO PROXY

 +3        DO MSG("Post-Init Complete")

 +4        DO APRIND

 +5        DO WSERV

 +6        DO PAYMIG

 +7        DO INDEX

 +8        QUIT 

 +9       ;

PROXY     ; Create an Application Proxy for PSO application

 +1        NEW X

 +2        SET X=$$CREATE^XUSAP("PSOAPPLICATIONPROXY,PSO","","PSO WEB SERVICES OPTION")

 +3       ;

 +4        IF +X=0

               Begin DoDot:1

 +5                DO BMSG("   Application Proxy User - 'PSOAPPLICATIONPROXY,PSO'")

 +6                DO MSG("   already exists in the NEW PERSON file (#200)")

                   DO MSG("")

               End DoDot:1

               QUIT 

 +7       ;

 +8        IF +X=-1

               Begin DoDot:1

 +9                DO BMSG("   Application Proxy User - 'PSOAPPLICATIONPROXY,PSO'")

 +10               DO MSG("   Unsuccessful; could not create Application Proxy User")

 +11               DO MSG("   OR error in call to UPDATE^DIE)")

                   DO MSG("")

               End DoDot:1

               QUIT 

 +12      ;

 +13       DO BMSG("   *****************************************************************")

 +14       DO MSG("   ** Application Proxy User - 'PSOAPPLICATIONPROXY,PSO' = created **")

 +15       DO MSG("   ** Secondary Menu Option - 'PSO WEB SERVICES OPTION' = linked   **")

 +16       DO MSG("   **                         to the Application Proxy.            **")

 +17       DO MSG("   ******************************************************************")

 +18       DO MSG("")

 +19       QUIT 

 +20      ;

 +21      ; A message is also recorded in INSTALL file

 +22      ; (#9.7) entry for the installation.

 +23      ;

 +24      ; Output a message.

MSG(MSG)  ; Integration Agreement #10141

 +1        DO MES^XPDUTL(MSG)

 +2        QUIT 

 +3       ;

 +4       ; Output a message with a blank line added.

BMSG(MSG) ; Integration Agreement #10141

 +1        DO BMES^XPDUTL(MSG)

 +2        QUIT 

 +3       ; create the APR index

APRIND    ;

 +1        NEW DIK,DA

 +2        SET DIK="^PSDRUG("

           SET DIK(1)="22^APR"

 +3        DO ENALL^DIK

 +4        QUIT 

 +5       ; create web server and service

WSERV     ;

 +1        NEW FDA,WSIEN,NWSIEN,WSERVIEN,WSRVIEN

 +2       ; if the web service already exists, this has been configured

 +3        IF $$FIND1^DIC(18.02,,"B","PSO ERX WEB SERVICE")

               QUIT 

 +4       ; set up the web service

 +5        SET FDA(18.02,"+1,",.01)="PSO ERX WEB SERVICE"

 +6        SET FDA(18.02,"+1,",.02)=2

 +7        SET FDA(18.02,"+1,",200)="/INB-ERX/"

 +8        DO UPDATE^DIE(,"FDA","WSIEN")

           KILL FDA

 +9        SET NWSIEN=$ORDER(WSIEN(0))

           SET NWSIEN=$GET(WSIEN(NWSIEN))

           if 'NWSIEN

               QUIT 

 +10       SET FDA(18.12,"+1,",.01)="PSO WEB SERVER"

 +11       SET FDA(18.12,"+1,",.03)=80

 +12      ;S FDA(18.12,"+1,",.04)="vaauserxappdev1.aac.domain.ext"

 +13       SET FDA(18.12,"+1,",.06)=1

 +14       SET FDA(18.12,"+1,",.07)=30

 +15       SET FDA(18.12,"+1,",1.01)=0

 +16       DO UPDATE^DIE(,"FDA","WSERVIEN")

           KILL FDA

 +17       SET WSRVIEN=$ORDER(WSERVIEN(0))

           if 'WSRVIEN

               QUIT 

 +18       SET WSRVIEN=$GET(WSERVIEN(WSRVIEN))

           if 'WSRVIEN

               QUIT 

 +19       SET FDA(18.121,"+1,"_WSRVIEN_",",.01)=NWSIEN

 +20       SET FDA(18.121,"+1,"_WSRVIEN_",",.06)=1

 +21       DO UPDATE^DIE(,"FDA",,"ERR")

           KILL FDA

 +22       QUIT 

CALL      ;

 +1        NEW I,X

 +2        FOR I=52.46,52.47,52.48,52.49

               Begin DoDot:1

 +3                SET X=0

                   FOR 

                       SET X=$ORDER(^PS(I,X))

                       if 'X

                           QUIT 

                       Begin DoDot:2

 +4                        SET FDA(I,X_",",.01)="@"

                       End DoDot:2

               End DoDot:1

 +5        DO FILE^DIE(,"FDA","FERR")

           KILL FDA

 +6        QUIT 

 +7       ; migrate payer fields for new cardholder and sequence structure

PAYMIG    ;

 +1        NEW ERXIEN,BFCIEN,CHID,BIENS,FDA,DA,DR

 +2       ; no need to reindex if there is no data

 +3        IF '$ORDER(^PS(52.49,0))

               QUIT 

 +4        SET ERXIEN=0

           FOR 

               SET ERXIEN=$ORDER(^PS(52.49,ERXIEN))

               if 'ERXIEN

                   QUIT 

               Begin DoDot:1

 +5       ; do not process entries that have already been converted

 +6                if $$GET1^DIQ(52.49,ERXIEN,44,"I")=1

                       QUIT 

 +7                SET BFCIEN=0

                   FOR 

                       SET BFCIEN=$ORDER(^PS(52.49,ERXIEN,18,BFCIEN))

                       if 'BFCIEN

                           QUIT 

                       Begin DoDot:2

 +8                        SET BIENS=BFCIEN_","_ERXIEN_","

 +9                        SET CHID=$$GET1^DIQ(52.4918,BIENS,.01,"E")

 +10      ; move the cardholder id to field 7 and change the .01 field to the IEN (as a sequence)

 +11                       SET FDA(52.4918,BIENS,7)=CHID

 +12                       SET FDA(52.4918,BIENS,.01)=BFCIEN

 +13                       DO FILE^DIE(,"FDA")

                           KILL FDA

                       End DoDot:2

 +14      ; set the conversion flag so this conversion will not run again for this entry.

 +15               SET DIE="^PS(52.49,"

                   SET DA=ERXIEN

                   SET DR="44///1"

                   DO ^DIE

                   KILL DIE

               End DoDot:1

 +16       QUIT 

 +17      ; reindex all files

INDEX     ;

 +1        NEW DIK,FILE

 +2       ; no need to reindex if there is no data

 +3        IF '$ORDER(^PS(52.49,0))

               QUIT 

 +4        FOR FILE="52.45","52.46","52.47","52.48","52.49"

               Begin DoDot:1

 +5                SET DIK="^PS("_FILE_","

                   DO IXALL2^DIK

                   DO IXALL^DIK

               End DoDot:1

 +6        QUIT