PSSUNMSI.m

PSSUNMSI ;BHAM ISC/MRR - Unmark Supply Items as Non-VA Med Flag ;06/25/03

 ;;7.0;OUTPATIENT PHARMACY;**69**;DEC 1997

 ;

 ; This makes the Environment Check run only at Install (no at Load)

 I '$G(XPDENV) Q

 ;

ASK W ! S DIR("A")="Unmark Supply Items as Non-VA Meds? "

 S DIR(0)="SA^Y:YES;N:NO",DIR("B")="YES" D ^DIR W !

 ;

 I $D(DTOUT)!$D(DUOUT) S XPDQUIT=1 Q

 I Y'="N",Y'="Y" G ASK

 W !,"   Supply items will "_$S(Y="N":"NOT",1:"")_" be unmarked as Non-VA Med"

 W !,"   with the installation of this patch.",!!

 S ^XTMP("PSS*1*69")=Y

 Q

 ;

EN N OI,APPUSE,DGIEN,X,PSSCROSS,PSSTEST 

 I $G(^XTMP("PSS*1*69"))'="Y" K ^XTMP("PSS*1*69") Q

 K ^XTMP("PSS*1*69"),^TMP("PSSOI",$J)

 ;

 ; - Updating APPL PCKGS' USE (File #50) and NON-VA MED (File #50.7)

 D BMES^XPDUTL("Unmarking supply items as Non-VA Meds...")

 S APPUSE=""

 F  S APPUSE=$O(^PSDRUG("IU",APPUSE)) Q:APPUSE=""  D

 . I APPUSE'["X" Q                           ; Not 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)),"^") Q:'OI   ; Get Orderable Item

 . . I '$P($G(^PS(50.7,OI,0)),"^",9) Q         ; OI is not Supply Item

 . . S OINAM=$P($G(^PS(50.7,OI,0)),"^")

 . . S $P(^PS(50.7,OI,0),"^",10)=0             ; Unmark as Non-VA Med

 . . D XREFS(DGIEN,APPUSE)                     ; Update x-references

 . . S ^TMP("PSSOI",$J,OI)=""

 D BMES^XPDUTL("Done!")

 ;

 ; Sends Master File Updates to CPRS

 D BMES^XPDUTL("Updating CPRS Orderable Item File...")

 S OI=0,PSSCROSS=1

 F  S OI=$O(^TMP("PSSOI",$J,OI)) Q:'OI  D

 . S PSSTEST=OI D EN1^PSSPOIDT

 D BMES^XPDUTL("Done!")

 ;

END K ^TMP("PSSOI",$J) Q

 ;

XREFS(DGIEN,APPUSE) ; - Updating existing x-references for the Application

 ;                   Use field (#63) - DRUG File

 N DGNAME,NEWAPP

 I $G(^PSDRUG(DGIEN,0))="" Q

 S DGNAME=$P(^PSDRUG(DGIEN,0),"^")           ; Retrive the Drug Name

 S NEWAPP=$TR(APPUSE,"X")                    ; Build the New App Use

 S $P(^PSDRUG(DGIEN,2),"^",3)=NEWAPP         ; Update the DRUG file

 K ^PSDRUG("AIUX",DGNAME,DGIEN)              ; Kill "AIU" x-reference

 K:APPUSE]"" ^PSDRUG("IU",APPUSE,DGIEN)      ; Kill "IU" x-reference

 S:NEWAPP]"" ^PSDRUG("IU",NEWAPP,DGIEN)=""   ; Set "IU" x-reference

 Q

PSSUNMSI  ;BHAM ISC/MRR - Unmark Supply Items as Non-VA Med Flag ;06/25/03

 +1       ;;7.0;OUTPATIENT PHARMACY;**69**;DEC 1997

 +2       ;

 +3       ; This makes the Environment Check run only at Install (no at Load)

 +4        IF '$GET(XPDENV)

               QUIT 

 +5       ;

ASK        WRITE !

           SET DIR("A")="Unmark Supply Items as Non-VA Meds? "

 +1        SET DIR(0)="SA^Y:YES;N:NO"

           SET DIR("B")="YES"

           DO ^DIR

           WRITE !

 +2       ;

 +3        IF $DATA(DTOUT)!$DATA(DUOUT)

               SET XPDQUIT=1

               QUIT 

 +4        IF Y'="N"

               IF Y'="Y"

                   GOTO ASK

 +5        WRITE !,"   Supply items will "_$SELECT(Y="N":"NOT",1:"")_" be unmarked as Non-VA Med"

 +6        WRITE !,"   with the installation of this patch.",!!

 +7        SET ^XTMP("PSS*1*69")=Y

 +8        QUIT 

 +9       ;

EN         NEW OI,APPUSE,DGIEN,X,PSSCROSS,PSSTEST

 +1        IF $GET(^XTMP("PSS*1*69"))'="Y"

               KILL ^XTMP("PSS*1*69")

               QUIT 

 +2        KILL ^XTMP("PSS*1*69"),^TMP("PSSOI",$JOB)

 +3       ;

 +4       ; - Updating APPL PCKGS' USE (File #50) and NON-VA MED (File #50.7)

 +5        DO BMES^XPDUTL("Unmarking supply items as Non-VA Meds...")

 +6        SET APPUSE=""

 +7        FOR 

               SET APPUSE=$ORDER(^PSDRUG("IU",APPUSE))

               IF APPUSE=""

                   QUIT 

               Begin DoDot:1

 +8       ; Not marked for Non-VA

                   IF APPUSE'["X"

                       QUIT 

 +9                SET DGIEN=""

 +10               FOR 

                       SET DGIEN=$ORDER(^PSDRUG("IU",APPUSE,DGIEN))

                       IF DGIEN=""

                           QUIT 

                       Begin DoDot:2

 +11      ; Drug is Inactive

                           IF $GET(^PSDRUG(DGIEN,"I"))

                               IF ($PIECE(^("I"),"^")<DT)

                                   QUIT 

 +12      ;

 +13      ; Get Orderable Item

                           SET OI=$PIECE($GET(^PSDRUG(DGIEN,2)),"^")

                           IF 'OI

                               QUIT 

 +14      ; OI is not Supply Item

                           IF '$PIECE($GET(^PS(50.7,OI,0)),"^",9)

                               QUIT 

 +15                       SET OINAM=$PIECE($GET(^PS(50.7,OI,0)),"^")

 +16      ; Unmark as Non-VA Med

                           SET $PIECE(^PS(50.7,OI,0),"^",10)=0

 +17      ; Update x-references

                           DO XREFS(DGIEN,APPUSE)

 +18                       SET ^TMP("PSSOI",$JOB,OI)=""

                       End DoDot:2

               End DoDot:1

 +19       DO BMES^XPDUTL("Done!")

 +20      ;

 +21      ; Sends Master File Updates to CPRS

 +22       DO BMES^XPDUTL("Updating CPRS Orderable Item File...")

 +23       SET OI=0

           SET PSSCROSS=1

 +24       FOR 

               SET OI=$ORDER(^TMP("PSSOI",$JOB,OI))

               IF 'OI

                   QUIT 

               Begin DoDot:1

 +25               SET PSSTEST=OI

                   DO EN1^PSSPOIDT

               End DoDot:1

 +26       DO BMES^XPDUTL("Done!")

 +27      ;

END        KILL ^TMP("PSSOI",$JOB)

           QUIT 

 +1       ;

XREFS(DGIEN,APPUSE) ; - Updating existing x-references for the Application

 +1       ;                   Use field (#63) - DRUG File

 +2        NEW DGNAME,NEWAPP

 +3        IF $GET(^PSDRUG(DGIEN,0))=""

               QUIT 

 +4       ; Retrive the Drug Name

           SET DGNAME=$PIECE(^PSDRUG(DGIEN,0),"^")

 +5       ; Build the New App Use

           SET NEWAPP=$TRANSLATE(APPUSE,"X")

 +6       ; Update the DRUG file

           SET $PIECE(^PSDRUG(DGIEN,2),"^",3)=NEWAPP

 +7       ; Kill "AIU" x-reference

           KILL ^PSDRUG("AIUX",DGNAME,DGIEN)

 +8       ; Kill "IU" x-reference

           IF APPUSE]""

               KILL ^PSDRUG("IU",APPUSE,DGIEN)

 +9       ; Set "IU" x-reference

           IF NEWAPP]""

               SET ^PSDRUG("IU",NEWAPP,DGIEN)=""

 +10       QUIT