| [613] | 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
 | 
|---|