PSO562PRE.m

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 ---PSO562PRE   1056     printed  Apr 09, 2024@21:30:42                                                                                                                                                                                                   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