| 1 | PSSUNMSI ;BHAM ISC/MRR - Unmark Supply Items as Non-VA Med Flag ;06/25/03
|
|---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;**69**;DEC 1997
|
|---|
| 3 | ;
|
|---|
| 4 | ; This makes the Environment Check run only at Install (no at Load)
|
|---|
| 5 | I '$G(XPDENV) Q
|
|---|
| 6 | ;
|
|---|
| 7 | ASK W ! S DIR("A")="Unmark Supply Items as Non-VA Meds? "
|
|---|
| 8 | S DIR(0)="SA^Y:YES;N:NO",DIR("B")="YES" D ^DIR W !
|
|---|
| 9 | ;
|
|---|
| 10 | I $D(DTOUT)!$D(DUOUT) S XPDQUIT=1 Q
|
|---|
| 11 | I Y'="N",Y'="Y" G ASK
|
|---|
| 12 | W !," Supply items will "_$S(Y="N":"NOT",1:"")_" be unmarked as Non-VA Med"
|
|---|
| 13 | W !," with the installation of this patch.",!!
|
|---|
| 14 | S ^XTMP("PSS*1*69")=Y
|
|---|
| 15 | Q
|
|---|
| 16 | ;
|
|---|
| 17 | EN N OI,APPUSE,DGIEN,X,PSSCROSS,PSSTEST
|
|---|
| 18 | I $G(^XTMP("PSS*1*69"))'="Y" K ^XTMP("PSS*1*69") Q
|
|---|
| 19 | K ^XTMP("PSS*1*69"),^TMP("PSSOI",$J)
|
|---|
| 20 | ;
|
|---|
| 21 | ; - Updating APPL PCKGS' USE (File #50) and NON-VA MED (File #50.7)
|
|---|
| 22 | D BMES^XPDUTL("Unmarking supply items as Non-VA Meds...")
|
|---|
| 23 | S APPUSE=""
|
|---|
| 24 | F S APPUSE=$O(^PSDRUG("IU",APPUSE)) Q:APPUSE="" D
|
|---|
| 25 | . I APPUSE'["X" Q ; Not marked for Non-VA
|
|---|
| 26 | . S DGIEN=""
|
|---|
| 27 | . F S DGIEN=$O(^PSDRUG("IU",APPUSE,DGIEN)) Q:DGIEN="" D
|
|---|
| 28 | . . I $G(^PSDRUG(DGIEN,"I")),($P(^("I"),"^")<DT) Q ; Drug is Inactive
|
|---|
| 29 | . . ;
|
|---|
| 30 | . . S OI=$P($G(^PSDRUG(DGIEN,2)),"^") Q:'OI ; Get Orderable Item
|
|---|
| 31 | . . I '$P($G(^PS(50.7,OI,0)),"^",9) Q ; OI is not Supply Item
|
|---|
| 32 | . . S OINAM=$P($G(^PS(50.7,OI,0)),"^")
|
|---|
| 33 | . . S $P(^PS(50.7,OI,0),"^",10)=0 ; Unmark as Non-VA Med
|
|---|
| 34 | . . D XREFS(DGIEN,APPUSE) ; Update x-references
|
|---|
| 35 | . . S ^TMP("PSSOI",$J,OI)=""
|
|---|
| 36 | D BMES^XPDUTL("Done!")
|
|---|
| 37 | ;
|
|---|
| 38 | ; Sends Master File Updates to CPRS
|
|---|
| 39 | D BMES^XPDUTL("Updating CPRS Orderable Item File...")
|
|---|
| 40 | S OI=0,PSSCROSS=1
|
|---|
| 41 | F S OI=$O(^TMP("PSSOI",$J,OI)) Q:'OI D
|
|---|
| 42 | . S PSSTEST=OI D EN1^PSSPOIDT
|
|---|
| 43 | D BMES^XPDUTL("Done!")
|
|---|
| 44 | ;
|
|---|
| 45 | END K ^TMP("PSSOI",$J) Q
|
|---|
| 46 | ;
|
|---|
| 47 | XREFS(DGIEN,APPUSE) ; - Updating existing x-references for the Application
|
|---|
| 48 | ; Use field (#63) - DRUG File
|
|---|
| 49 | N DGNAME,NEWAPP
|
|---|
| 50 | I $G(^PSDRUG(DGIEN,0))="" Q
|
|---|
| 51 | S DGNAME=$P(^PSDRUG(DGIEN,0),"^") ; Retrive the Drug Name
|
|---|
| 52 | S NEWAPP=$TR(APPUSE,"X") ; Build the New App Use
|
|---|
| 53 | S $P(^PSDRUG(DGIEN,2),"^",3)=NEWAPP ; Update the DRUG file
|
|---|
| 54 | K ^PSDRUG("AIUX",DGNAME,DGIEN) ; Kill "AIU" x-reference
|
|---|
| 55 | K:APPUSE]"" ^PSDRUG("IU",APPUSE,DGIEN) ; Kill "IU" x-reference
|
|---|
| 56 | S:NEWAPP]"" ^PSDRUG("IU",NEWAPP,DGIEN)="" ; Set "IU" x-reference
|
|---|
| 57 | Q
|
|---|
