PSSPOST6 ;BHAM ISC/MR - Master File Update for Non-VA Med Flag ; 03/19/02
;;7.0;OUTPATIENT PHARMACY;**68**;DEC 1997
;
N OI,APPUSE,DGIEN
;
; - Initializing NON-VA MED field (#8) on File #50.7
S OI="" F S OI=$O(^PS(50.7,OI)) Q:'OI S $P(^PS(50.7,OI,0),"^",10)=""
;
; - Updating APPL PCKGS' USE (File #50) and NON-VA MED (File #50.7)
S APPUSE=""
F S APPUSE=$O(^PSDRUG("IU",APPUSE)) Q:APPUSE="" D
. I APPUSE'["O" Q ; Not marked for Outpatient
. I APPUSE["X" Q ; Already marked for Non-VA
. S DGIEN=""
. F S DGIEN=$O(^PSDRUG("IU",APPUSE,DGIEN)) Q:DGIEN="" D
. . I $G(^PSDRUG(DGIEN,"I")),($P(^("I"),"^")<DT) Q ; Drug is Inactive
. . ;
. . S OI=$P($G(^PSDRUG(DGIEN,2)),"^") ; Get Orderable Item
. . I OI S $P(^PS(50.7,OI,0),"^",10)=1 ; Mark as Non-VA Med
. . D XREFS(DGIEN,APPUSE) ; Update x-references
. . W !,"Updating Drug ",DGIEN
;
END Q
;
XREFS(DGIEN,APPUSE) ; - Updating existing x-references for the Application
; Use field (#63) - DRUG File
N DGNAME,NEWAPP
S DGNAME=$P(^PSDRUG(DGIEN,0),"^") ; Retrive the Drug Name
S NEWAPP=APPUSE_"X" ; Build the New App Use
S $P(^PSDRUG(DGIEN,2),"^",3)=NEWAPP ; Update the DRUG file
S ^PSDRUG("AIUX",DGNAME,DGIEN)="" ; Set "AIU" x-reference
K:APPUSE]"" ^PSDRUG("IU",APPUSE,DGIEN) ; Kill "IU" x-reference
S ^PSDRUG("IU",NEWAPP,DGIEN)="" ; Set "IU" x-reference
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSPOST6 1538 printed Dec 13, 2024@02:34:09 Page 2
PSSPOST6 ;BHAM ISC/MR - Master File Update for Non-VA Med Flag ; 03/19/02
+1 ;;7.0;OUTPATIENT PHARMACY;**68**;DEC 1997
+2 ;
+3 NEW OI,APPUSE,DGIEN
+4 ;
+5 ; - Initializing NON-VA MED field (#8) on File #50.7
+6 SET OI=""
FOR
SET OI=$ORDER(^PS(50.7,OI))
if 'OI
QUIT
SET $PIECE(^PS(50.7,OI,0),"^",10)=""
+7 ;
+8 ; - Updating APPL PCKGS' USE (File #50) and NON-VA MED (File #50.7)
+9 SET APPUSE=""
+10 FOR
SET APPUSE=$ORDER(^PSDRUG("IU",APPUSE))
if APPUSE=""
QUIT
Begin DoDot:1
+11 ; Not marked for Outpatient
IF APPUSE'["O"
QUIT
+12 ; Already marked for Non-VA
IF APPUSE["X"
QUIT
+13 SET DGIEN=""
+14 FOR
SET DGIEN=$ORDER(^PSDRUG("IU",APPUSE,DGIEN))
if DGIEN=""
QUIT
Begin DoDot:2
+15 ; Drug is Inactive
IF $GET(^PSDRUG(DGIEN,"I"))
IF ($PIECE(^("I"),"^")<DT)
QUIT
+16 ;
+17 ; Get Orderable Item
SET OI=$PIECE($GET(^PSDRUG(DGIEN,2)),"^")
+18 ; Mark as Non-VA Med
IF OI
SET $PIECE(^PS(50.7,OI,0),"^",10)=1
+19 ; Update x-references
DO XREFS(DGIEN,APPUSE)
+20 WRITE !,"Updating Drug ",DGIEN
End DoDot:2
End DoDot:1
+21 ;
END QUIT
+1 ;
XREFS(DGIEN,APPUSE) ; - Updating existing x-references for the Application
+1 ; Use field (#63) - DRUG File
+2 NEW DGNAME,NEWAPP
+3 ; Retrive the Drug Name
SET DGNAME=$PIECE(^PSDRUG(DGIEN,0),"^")
+4 ; Build the New App Use
SET NEWAPP=APPUSE_"X"
+5 ; Update the DRUG file
SET $PIECE(^PSDRUG(DGIEN,2),"^",3)=NEWAPP
+6 ; Set "AIU" x-reference
SET ^PSDRUG("AIUX",DGNAME,DGIEN)=""
+7 ; Kill "IU" x-reference
if APPUSE]""
KILL ^PSDRUG("IU",APPUSE,DGIEN)
+8 ; Set "IU" x-reference
SET ^PSDRUG("IU",NEWAPP,DGIEN)=""
+9 QUIT
