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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSUNMSI 2347 printed Sep 23, 2025@20:10:19 Page 2
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
