IB20P347 ;BP/BDM - PHARMACY API CALLS POST-INSTALL ROUTINE; DECEMBER 20, 2006
 ;;2.0;INTEGRATED BILLING;**347**;21-MAR-94;Build 24
 ;
 ;This is a post-install routine
 ;
 ;The purpose of this routine is to modify six entries in file ^IBE(350.1 to comply with
 ;new pharmacy APIs.
 ;
 N CNT,CNT2,CODE,IBN,IBSUB
 F CNT=1:1 S IBSUB=$P($T(ENTRIES+CNT),";;",2) Q:IBSUB="END"  S IBN=$O(^IBE(350.1,"B",IBSUB,0)) I IBN D
 .F CNT2=1:1 S CODE=$P($T(ENTRIES+CNT2),";;",2) Q:CODE="END"  D
 .S ^IBE(350.1,IBN,20)=$P($T(CODE+1),";;",2)
 Q
ENTRIES ;Entries for file 350.1
 ;;PSO NSC RX COPAY CANCEL
 ;;PSO NSC RX COPAY NEW
 ;;PSO NSC RX COPAY UPDATE
 ;;PSO SC RX COPAY CANCEL
 ;;PSO SC RX COPAY NEW
 ;;PSO SC RX COPAY UPDATE
 ;;END
CODE ;
 ;;S:'$D(^(10)) X="" I $D(^(10)) X ^(10) S X=$S($D(Y(0)):$P(Y(0),U),1:"UNK") I $D(Y(0)) S X=X_"-"_$S($$DRUG^IBRXUTL1(+$P(Y(0),U,6))'="":$$DRUG^IBRXUTL1(+$P(Y(0),U,6)),1:"UNK DRUG"),X=$E(X,1,18)_"-"_$S($D(IBUNIT):IBUNIT,$D(IBX):$P(IBX,U,2),1:"")
 ;;END
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P347   1000     printed  Sep 23, 2025@19:38:23                                                                                                                                                                                                    Page 2
IB20P347  ;BP/BDM - PHARMACY API CALLS POST-INSTALL ROUTINE; DECEMBER 20, 2006
 +1       ;;2.0;INTEGRATED BILLING;**347**;21-MAR-94;Build 24
 +2       ;
 +3       ;This is a post-install routine
 +4       ;
 +5       ;The purpose of this routine is to modify six entries in file ^IBE(350.1 to comply with
 +6       ;new pharmacy APIs.
 +7       ;
 +8        NEW CNT,CNT2,CODE,IBN,IBSUB
 +9        FOR CNT=1:1
               SET IBSUB=$PIECE($TEXT(ENTRIES+CNT),";;",2)
               if IBSUB="END"
                   QUIT 
               SET IBN=$ORDER(^IBE(350.1,"B",IBSUB,0))
               IF IBN
                   Begin DoDot:1
 +10                   FOR CNT2=1:1
                           SET CODE=$PIECE($TEXT(ENTRIES+CNT2),";;",2)
                           if CODE="END"
                               QUIT 
                           Begin DoDot:2
                           End DoDot:2
 +11                   SET ^IBE(350.1,IBN,20)=$PIECE($TEXT(CODE+1),";;",2)
                   End DoDot:1
 +12       QUIT 
ENTRIES   ;Entries for file 350.1
 +1       ;;PSO NSC RX COPAY CANCEL
 +2       ;;PSO NSC RX COPAY NEW
 +3       ;;PSO NSC RX COPAY UPDATE
 +4       ;;PSO SC RX COPAY CANCEL
 +5       ;;PSO SC RX COPAY NEW
 +6       ;;PSO SC RX COPAY UPDATE
 +7       ;;END
CODE      ;
 +1       ;;S:'$D(^(10)) X="" I $D(^(10)) X ^(10) S X=$S($D(Y(0)):$P(Y(0),U),1:"UNK") I $D(Y(0)) S X=X_"-"_$S($$DRUG^IBRXUTL1(+$P(Y(0),U,6))'="":$$DRUG^IBRXUTL1(+$P(Y(0),U,6)),1:"UNK DRUG"),X=$E(X,1,18)_"-"_$S($D(IBUNIT):IBUNIT,$D(IBX):$P(IBX,U,2),1:"")
 +2       ;;END