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 ---[H[J[2J[HPSO467PO 3925 printed Sep 23, 2025@19:59:08 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
