source: FOIAVistA/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSP130.m@ 1119

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

initial load of FOIAVistA 6/30/08 version

File size: 3.9 KB
Line 
1PSSP130 ;BIR/RJS-REINDEX "VAC" X-REFERENCE ON DRUG FILE (#50)
2 ;;1.0; PHARMACY DATA MANAGEMENT;**130**;9/30/97;Build 6
3 ;;Reference to $$SETSTR^VALM1 is covered by DBIA #10116
4 ;;Reference to $$TRIM^XLFSTR is covered by DBIA #10104
5 ;;Reference to ^XMD is covered by DBIA #10070
6 ;;
7SYN ;Remove the un wanted spaces from the Pharmacy Orderable Items synonym
8 N X
9 S PSSIEN=0 F S PSSIEN=$O(^PS(50.7,PSSIEN)) Q:'PSSIEN D
10 .S PSSSYN=0 F S PSSSYN=$O(^PS(50.7,PSSIEN,2,PSSSYN)) Q:'PSSSYN D
11 ..S PSSNM=$G(^PS(50.7,PSSIEN,2,PSSSYN,0))
12 ..S PSSLEN=$L(PSSNM) S PSSNAM=$$TRIM^XLFSTR(PSSNM,," ")
13 ..I $L(PSSNAM)<$L(PSSNM) S ^TMP($J,"PSSP130-1",PSSIEN,PSSSYN)=PSSNAM
14 S PSSIEN=0
15 S XMSUB="PSS*1*130 Pharmacy Orderable Item Synonym Repair Report"
16 S ^TMP($J,"PSSP130",1)="PSS*1*130 Pharmacy Orderable Item Synonym Repair"
17 S ^TMP($J,"PSSP130",2)="The following Orderable Items contained leading/trailing spaces"
18 S ^TMP($J,"PSSP130",3)=""
19 I '$D(^TMP($J,"PSSP130-1")) S ^TMP($J,"PSSP130",4)="No multiple indexs found.",^TMP($J,"PSSP130",5)="",PSSCNT=5 D MAIL G VAC
20 S X="" D TXT("ORDERABLE ITEM",1),TXT("IEN",40),TXT("SYNONYM",48)
21 S ^TMP($J,"PSSP130",4)=X,^TMP($J,"PSSP130",5)="",PSSCNT=5
22 S PSSIEN=0 F S PSSIEN=$O(^TMP($J,"PSSP130-1",PSSIEN)) Q:'PSSIEN D
23 .S PSSSYN=0 F S PSSSYN=$O(^TMP($J,"PSSP130-1",PSSIEN,PSSSYN)) Q:'PSSSYN D
24 ..N DIE,DA,DR
25 ..S PSSNM=$G(^TMP($J,"PSSP130-1",PSSIEN,PSSSYN)),DA(1)=PSSIEN,DA=PSSSYN
26 ..S DIE="^PS(50.7,"_DA(1)_","_2_",",DR=".01////^S X=PSSNM" D ^DIE
27 ..S X="" D TXT($P(^PS(50.7,PSSIEN,0),"^"),1),TXT(PSSIEN,40),TXT(PSSNM,48)
28 ..S PSSCNT=PSSCNT+1,^TMP($J,"PSSP130",PSSCNT)=X
29 S PSSCNT=PSSCNT+1,^TMP($J,"PSSP130",PSSCNT)=""
30 D MAIL
31 ;
32VAC ; Re_index VAC cross-reference.
33 S PSSVAC=""
34 F S PSSVAC=$O(^PSDRUG("VAC",PSSVAC)) Q:'PSSVAC D
35 .S PSSIEN=""
36 .F S PSSIEN=$O(^PSDRUG("VAC",PSSVAC,PSSIEN)) Q:'PSSIEN S ^TMP($J,"PSSP130-1",PSSIEN,PSSVAC)=$P(^PS(50.605,PSSVAC,0),"^",1)
37 S PSSIEN=""
38 F S PSSIEN=$O(^TMP($J,"PSSP130-1",PSSIEN)) Q:'PSSIEN D
39 .S PSSCNT=0,PSSVAC=""
40 .F S PSSVAC=$O(^TMP($J,"PSSP130-1",PSSIEN,PSSVAC)) Q:'PSSVAC S PSSCNT=PSSCNT+1,^TMP($J,"PSSP130-1",PSSIEN)=PSSCNT
41 S PSSIEN=""
42 F S PSSIEN=$O(^TMP($J,"PSSP130-1",PSSIEN)) Q:'PSSIEN K:$G(^TMP($J,"PSSP130-1",PSSIEN))<2 ^TMP($J,"PSSP130-1",PSSIEN)
43 F S PSSIEN=$O(^TMP($J,"PSSP130-1",PSSIEN)) Q:'PSSIEN D
44 .S PSSVAC=""
45 .F S PSSVAC=$O(^TMP($J,"PSSP130-1",PSSIEN,PSSVAC)) Q:'PSSVAC D
46 ..K:$D(^PSDRUG("VAC",PSSVAC,PSSIEN)) ^PSDRUG("VAC",PSSVAC,PSSIEN)
47 .S DA=PSSIEN,DIK="^PSDRUG(",DIK(1)="25"
48 .D EN^DIK K DA,DIK
49 S XMSUB="PSS*1*130 Re-index the Drugs VAC report"
50 S ^TMP($J,"PSSP130",1)="PSS*1*130 Re-index - VAC - Drugs to VA Drug Class"
51 S ^TMP($J,"PSSP130",2)="The following Drug(s) had multiple VAC indexs"
52 S ^TMP($J,"PSSP130",3)=""
53 I '$D(^TMP($J,"PSSP130-1")) S ^TMP($J,"PSSP130",4)="No multiple indexs found.",^TMP($J,"PSSP130",5)="",PSSCNT=5 G MAIL
54 S X="" D TXT("-- VA Drug Class --",50)
55 S ^TMP($J,"PSSP130",4)=X
56 S X="" D TXT("Drug Name",1),TXT("DRG#",40),TXT("Multiple",48),TXT("Re-indexed",61)
57 S ^TMP($J,"PSSP130",5)=X
58 S PSSIEN="",PSSCNT=5
59 F S PSSIEN=$O(^TMP($J,"PSSP130-1",PSSIEN)) Q:'PSSIEN D
60 .S X="" D TXT($P(^PSDRUG(PSSIEN,0),"^",1),1),TXT(PSSIEN,40)
61 .S PSSVAC="",PSSFLG=0
62 .F S PSSVAC=$O(^PSDRUG("VAC",PSSVAC)) Q:'PSSVAC D
63 ..S:$D(^PSDRUG("VAC",PSSVAC,PSSIEN)) ^TMP($J,"PSSP130-1",PSSIEN)=$P(^PS(50.605,PSSVAC,0),"^",1)
64 .S PSSVACO="" F S PSSVACO=$O(^TMP($J,"PSSP130-1",PSSIEN,PSSVACO)) Q:'PSSVACO D
65 ..D TXT($G(^TMP($J,"PSSP130-1",PSSIEN,PSSVACO)),50) D:'PSSFLG TXT($G(^TMP($J,"PSSP130-1",PSSIEN)),64)
66 ..S PSSFLG=1,PSSCNT=PSSCNT+1,^TMP($J,"PSSP130",PSSCNT)=X,X=""
67 .S PSSCNT=PSSCNT+1,^TMP($J,"PSSP130",PSSCNT)=""
68MAIL N DIFROM
69 S PSSCNT=PSSCNT+1,^TMP($J,"PSSP130",PSSCNT)="***** End Of Report *****"
70 S XMTEXT="^TMP($J,""PSSP130"",",XMDUZ="PSS*1*130 Post Install"
71 S XMY(DUZ)=""
72 D ^XMD
73EXIT ; CLEAN UP
74 K ^TMP($J),PSSCNT,PSSFLG,PSSIEN,PSSVAC,PSSVACO,XMDUZ,XMSUB,XMTEXT,XMY,PSSSYN,PSSNM,PSSLEN,PSSNAM
75 Q
76TXT(VAL,COL) S:'$D(X) X="" S X=$$SETSTR^VALM1(VAL,X,COL,$L(VAL))
77 Q
Note: See TracBrowser for help on using the repository browser.