source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSUNMSI.m@ 1096

Last change on this file since 1096 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1PSSUNMSI ;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 ;
7ASK 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 ;
17EN 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 ;
45END K ^TMP("PSSOI",$J) Q
46 ;
47XREFS(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
Note: See TracBrowser for help on using the repository browser.