| 1 | IBY374PO ;PRXM/CMW - Post install routine for patch 374 ; 10 May 2007 9:41 AM
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**374**;21-MAR-94;Build 16
|
|---|
| 3 | ;
|
|---|
| 4 | ; Call at tags only
|
|---|
| 5 | Q
|
|---|
| 6 | ; This routine will clean up entries in the file with NPIs delete status (2)
|
|---|
| 7 | ;
|
|---|
| 8 | EN ; Post Install Routine primary entry point
|
|---|
| 9 | ;
|
|---|
| 10 | D DEL
|
|---|
| 11 | D CLEAN
|
|---|
| 12 | Q
|
|---|
| 13 | ;
|
|---|
| 14 | DEL ; Look for NPI with delete status of "2"
|
|---|
| 15 | N IBIEN,STA,DA,IBOLDNPI
|
|---|
| 16 | S IBIEN=0
|
|---|
| 17 | F S IBIEN=$O(^IBA(355.93,IBIEN)) Q:'IBIEN D
|
|---|
| 18 | . S DA="A"
|
|---|
| 19 | . ; Loop through deleted NPIs (Status "2")
|
|---|
| 20 | . S STA=2
|
|---|
| 21 | . F S DA=$O(^IBA(355.93,IBIEN,"NPISTATUS","NPISTATUS",STA,DA),-1) Q:'DA D
|
|---|
| 22 | . . S IBOLDNPI=$P(^IBA(355.93,IBIEN,"NPISTATUS",DA,0),U,3)
|
|---|
| 23 | . . D COMP
|
|---|
| 24 | Q
|
|---|
| 25 | ;
|
|---|
| 26 | COMP ;COMPLETELY DELETE THE NPI
|
|---|
| 27 | ;If NPI has status of "2" remove all entries related to this NPI.
|
|---|
| 28 | N OIEN
|
|---|
| 29 | S OIEN="A"
|
|---|
| 30 | F S OIEN=$O(^IBA(355.93,IBIEN,"NPISTATUS","C",IBOLDNPI,OIEN),-1) Q:'OIEN D
|
|---|
| 31 | . NEW DIE,DIK,DIC,DA,DR,D,D0,DI,DIC,DQ,X
|
|---|
| 32 | . NEW DP,DM,DK,DL,DIEL
|
|---|
| 33 | . S DA(1)=IBIEN,DIK="^IBA(355.93,"_DA(1)_",""NPISTATUS"",",DA=OIEN
|
|---|
| 34 | . D ^DIK
|
|---|
| 35 | . ; kill 41.01 references
|
|---|
| 36 | . K ^IBA(355.93,"NPI",IBOLDNPI,DA),^IBA(355.93,"NPIHISTORY",IBOLDNPI,DA)
|
|---|
| 37 | Q
|
|---|
| 38 | ;
|
|---|
| 39 | CLEAN ; Clean up ^IBA(355.93,IEN,"NPISTATUS",0) if there are no multiples in the sub-file.
|
|---|
| 40 | N IBIEN
|
|---|
| 41 | S IBIEN=0
|
|---|
| 42 | F S IBIEN=$O(^IBA(355.93,IBIEN)) Q:'IBIEN D
|
|---|
| 43 | . Q:$G(^IBA(355.93,IBIEN,"NPISTATUS",0))=""
|
|---|
| 44 | . I +$P($G(^IBA(355.93,IBIEN,"NPISTATUS",0)),U,4)=0 D
|
|---|
| 45 | . . K ^IBA(355.93,IBIEN,"NPISTATUS",0)
|
|---|
| 46 | Q
|
|---|
