source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBY374PO.m@ 1579

Last change on this file since 1579 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.4 KB
RevLine 
[613]1IBY374PO ;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 ;
8EN ; Post Install Routine primary entry point
9 ;
10 D DEL
11 D CLEAN
12 Q
13 ;
14DEL ; 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 ;
26COMP ;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 ;
39CLEAN ; 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
Note: See TracBrowser for help on using the repository browser.