- 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
