IB20P160 ;ALB/ARH - IB*2*160 POST INIT: ORIGINAL RX IN CT ; 07/11/01
;;2.0;INTEGRATED BILLING;**160**;21-MAR-94
;
Q
POST ;
N IBA
S IBA(1)="",IBA(2)=" IB*2*160 Post-Install .....",IBA(3)="" D MES^XPDUTL(.IBA) K IBA
;
D RXABBR ; update Prescription Refill Abbreviation (356.6,.02)
;
S IBA(1)="",IBA(2)=" IB*2*160 Post-Install Complete",IBA(3)="" D MES^XPDUTL(.IBA) K IBA
Q
;
RXABBR ; change the Prescription Refill abbreviation from 'RxRefill' to 'RxFill' (356.6,.02)
N IBA,IBFN,DD,DO,DLAYGO,DIC,DIE,DA,DR,X,Y
;
;
S IBFN=$O(^IBE(356.6,"B","PRESCRIPTION REFILL",0))
I $P($G(^IBE(356.6,+IBFN,0)),U,3)'=3 S IBFN=""
;
I +IBFN S DR=".02///RxFill",DIE="^IBE(356.6,",DA=+IBFN D ^DIE K DIE,DA,DR,X,Y
;
S IBA(1)=" >> Prescription Abreviation "_$S('IBFN:"NOT ",1:"")_"updated (#356.6,.02)" D MES^XPDUTL(.IBA) K IBA
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P160 860 printed Nov 22, 2024@17:11:51 Page 2
IB20P160 ;ALB/ARH - IB*2*160 POST INIT: ORIGINAL RX IN CT ; 07/11/01
+1 ;;2.0;INTEGRATED BILLING;**160**;21-MAR-94
+2 ;
+3 QUIT
POST ;
+1 NEW IBA
+2 SET IBA(1)=""
SET IBA(2)=" IB*2*160 Post-Install ....."
SET IBA(3)=""
DO MES^XPDUTL(.IBA)
KILL IBA
+3 ;
+4 ; update Prescription Refill Abbreviation (356.6,.02)
DO RXABBR
+5 ;
+6 SET IBA(1)=""
SET IBA(2)=" IB*2*160 Post-Install Complete"
SET IBA(3)=""
DO MES^XPDUTL(.IBA)
KILL IBA
+7 QUIT
+8 ;
RXABBR ; change the Prescription Refill abbreviation from 'RxRefill' to 'RxFill' (356.6,.02)
+1 NEW IBA,IBFN,DD,DO,DLAYGO,DIC,DIE,DA,DR,X,Y
+2 ;
+3 ;
+4 SET IBFN=$ORDER(^IBE(356.6,"B","PRESCRIPTION REFILL",0))
+5 IF $PIECE($GET(^IBE(356.6,+IBFN,0)),U,3)'=3
SET IBFN=""
+6 ;
+7 IF +IBFN
SET DR=".02///RxFill"
SET DIE="^IBE(356.6,"
SET DA=+IBFN
DO ^DIE
KILL DIE,DA,DR,X,Y
+8 ;
+9 SET IBA(1)=" >> Prescription Abreviation "_$SELECT('IBFN:"NOT ",1:"")_"updated (#356.6,.02)"
DO MES^XPDUTL(.IBA)
KILL IBA
+10 QUIT
