| [613] | 1 | PSSPOST6 ;BHAM ISC/MR - Master File Update for Non-VA Med Flag ; 03/19/02
 | 
|---|
 | 2 |  ;;7.0;OUTPATIENT PHARMACY;**68**;DEC 1997
 | 
|---|
 | 3 |  ;
 | 
|---|
 | 4 |  N OI,APPUSE,DGIEN
 | 
|---|
 | 5 |  ;
 | 
|---|
 | 6 |  ; - Initializing NON-VA MED field (#8) on File #50.7
 | 
|---|
 | 7 |  S OI="" F  S OI=$O(^PS(50.7,OI)) Q:'OI  S $P(^PS(50.7,OI,0),"^",10)=""
 | 
|---|
 | 8 |  ;
 | 
|---|
 | 9 |  ; - Updating APPL PCKGS' USE (File #50) and NON-VA MED (File #50.7)
 | 
|---|
 | 10 |  S APPUSE=""
 | 
|---|
 | 11 |  F  S APPUSE=$O(^PSDRUG("IU",APPUSE)) Q:APPUSE=""  D
 | 
|---|
 | 12 |  . I APPUSE'["O" Q                           ; Not marked for Outpatient
 | 
|---|
 | 13 |  . I APPUSE["X" Q                            ; Already marked for Non-VA
 | 
|---|
 | 14 |  . S DGIEN=""
 | 
|---|
 | 15 |  . F  S DGIEN=$O(^PSDRUG("IU",APPUSE,DGIEN)) Q:DGIEN=""  D
 | 
|---|
 | 16 |  . . I $G(^PSDRUG(DGIEN,"I")),($P(^("I"),"^")<DT) Q   ; Drug is Inactive
 | 
|---|
 | 17 |  . . ;
 | 
|---|
 | 18 |  . . S OI=$P($G(^PSDRUG(DGIEN,2)),"^")       ; Get Orderable Item
 | 
|---|
 | 19 |  . . I OI S $P(^PS(50.7,OI,0),"^",10)=1      ; Mark as Non-VA Med
 | 
|---|
 | 20 |  . . D XREFS(DGIEN,APPUSE)                   ; Update x-references
 | 
|---|
 | 21 |  . . W !,"Updating Drug ",DGIEN
 | 
|---|
 | 22 |  ;
 | 
|---|
 | 23 | END Q
 | 
|---|
 | 24 |  ;
 | 
|---|
 | 25 | XREFS(DGIEN,APPUSE) ; - Updating existing x-references for the Application
 | 
|---|
 | 26 |  ;                   Use field (#63) - DRUG File
 | 
|---|
 | 27 |  N DGNAME,NEWAPP
 | 
|---|
 | 28 |  S DGNAME=$P(^PSDRUG(DGIEN,0),"^")           ; Retrive the Drug Name
 | 
|---|
 | 29 |  S NEWAPP=APPUSE_"X"                         ; Build the New App Use
 | 
|---|
 | 30 |  S $P(^PSDRUG(DGIEN,2),"^",3)=NEWAPP         ; Update the DRUG file
 | 
|---|
 | 31 |  S ^PSDRUG("AIUX",DGNAME,DGIEN)=""           ; Set "AIU" x-reference
 | 
|---|
 | 32 |  K:APPUSE]"" ^PSDRUG("IU",APPUSE,DGIEN)      ; Kill "IU" x-reference
 | 
|---|
 | 33 |  S ^PSDRUG("IU",NEWAPP,DGIEN)=""             ; Set "IU" x-reference
 | 
|---|
 | 34 |  Q
 | 
|---|