PSSPOST6.m

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 ---PSSPOST6   1538     printed  Apr 09, 2024@21:31:43                                                                                                                                                                                                    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