PSO562PRE ;AITC/PD - Pre-install for PSO*7.0*562 ; 9/1/20
;;7.0;OUTPATIENT PHARMACY;**562**;DEC 1997;Build 19
;
Q
;
PRE ; Pre-install functions are coded here
;
D MES^XPDUTL(" Starting pre-install of PSO*7*562")
;
; Remove RRR Reject Code 943 from EPHARMACY SITE PARAMETERS (#52.86)
D RRR
;
D MES^XPDUTL(" Finished pre-install of PSO*7*562")
Q
;
RRR ; Remove RRR Reject Code 943 from EPHARMACY SITE PARAMETERS
;
N CNT,DA,DIK,PSODIV,REJIEN,RRRIEN
;
S REJIEN=$O(^BPSF(9002313.93,"B",943,""))
I REJIEN="" Q
;
S CNT=0
;
D MES^XPDUTL(" ")
D MES^XPDUTL(" - Updating EPHARMACY SITE PARAMETERS")
;
S PSODIV=0
F S PSODIV=$O(^PS(52.86,PSODIV)) Q:'PSODIV D
. I '$D(^PS(52.86,PSODIV,5,"B",REJIEN)) Q
. S RRRIEN=$O(^PS(52.86,PSODIV,5,"B",REJIEN,""))
. I RRRIEN="" Q
. ;
. S DIK="^PS(52.86,"_PSODIV_",5,"
. S DA(1)=PSODIV
. S DA=RRRIEN
. D ^DIK
. S CNT=CNT+1
;
D MES^XPDUTL(" - "_CNT_" entries updated")
D MES^XPDUTL(" - Done with EPHARMACY SITE PARAMETERS")
D MES^XPDUTL(" ")
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSO562PRE 1056 printed Oct 16, 2024@18:23:56 Page 2
PSO562PRE ;AITC/PD - Pre-install for PSO*7.0*562 ; 9/1/20
+1 ;;7.0;OUTPATIENT PHARMACY;**562**;DEC 1997;Build 19
+2 ;
+3 QUIT
+4 ;
PRE ; Pre-install functions are coded here
+1 ;
+2 DO MES^XPDUTL(" Starting pre-install of PSO*7*562")
+3 ;
+4 ; Remove RRR Reject Code 943 from EPHARMACY SITE PARAMETERS (#52.86)
+5 DO RRR
+6 ;
+7 DO MES^XPDUTL(" Finished pre-install of PSO*7*562")
+8 QUIT
+9 ;
RRR ; Remove RRR Reject Code 943 from EPHARMACY SITE PARAMETERS
+1 ;
+2 NEW CNT,DA,DIK,PSODIV,REJIEN,RRRIEN
+3 ;
+4 SET REJIEN=$ORDER(^BPSF(9002313.93,"B",943,""))
+5 IF REJIEN=""
QUIT
+6 ;
+7 SET CNT=0
+8 ;
+9 DO MES^XPDUTL(" ")
+10 DO MES^XPDUTL(" - Updating EPHARMACY SITE PARAMETERS")
+11 ;
+12 SET PSODIV=0
+13 FOR
SET PSODIV=$ORDER(^PS(52.86,PSODIV))
if 'PSODIV
QUIT
Begin DoDot:1
+14 IF '$DATA(^PS(52.86,PSODIV,5,"B",REJIEN))
QUIT
+15 SET RRRIEN=$ORDER(^PS(52.86,PSODIV,5,"B",REJIEN,""))
+16 IF RRRIEN=""
QUIT
+17 ;
+18 SET DIK="^PS(52.86,"_PSODIV_",5,"
+19 SET DA(1)=PSODIV
+20 SET DA=RRRIEN
+21 DO ^DIK
+22 SET CNT=CNT+1
End DoDot:1
+23 ;
+24 DO MES^XPDUTL(" - "_CNT_" entries updated")
+25 DO MES^XPDUTL(" - Done with EPHARMACY SITE PARAMETERS")
+26 DO MES^XPDUTL(" ")
+27 ;
+28 QUIT
