Routine: IB20P347

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)

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  Feb 18, 2025@23:28:39                                                                                                                                                                                                    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

IB20P347.m