source: FOIAVistA/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJA0103.m@ 957

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

initial load of FOIAVistA 6/30/08 version
File size: 4.8 KB
Line 
1PSJA0103 ;BIR/JLC - Check for Non-Standard Schedules ;01-MAR-04
2 ;;5.0; INPATIENT MEDICATIONS ;**103**;16 DEC 97
3 ;
4SENDMSG ;
5 D NOW^%DTC S (Y,YA)=% X ^DD("DD") S YT=Y
6 K PSG,XMY S XMDUZ="MEDICATIONS,INPATIENT",XMSUB="ADMIN SCHEDULES",XMTEXT="PSG(",XMY(DUZ)=""
7 S PSG(1,0)=" The check of Inpatient Medications 5.0 orders is complete."
8 S PSG(2,0)=" ",PSG(3,0)=" Here is the list of all medication administration schedules in use: ",PSG(4,0)=" "
9 S PSJSCHD="",OCNT=4,X=""
10 F S PSJSCHD=$O(^XTMP("PSJSC","ALL",PSJSCHD)) Q:PSJSCHD="" S X=X_PSJSCHD_", " I $L(X)>60 S OCNT=OCNT+1,PSG(OCNT,0)=X,X=""
11 I X]"" S OCNT=OCNT+1,PSG(OCNT,0)=X
12 D ^XMD
13 K PSG S XMDUZ="MEDICATIONS,INPATIENT",XMSUB="ADMIN SCHEDULES NOT IN 51.1",XMTEXT="PSG(",XMY(DUZ)=""
14 S PSG(1,0)=" The check of Inpatient Medications 5.0 orders is complete."
15 S PSG(2,0)=" ",PSG(3,0)="Here is the list of administration schedules not in the",PSG(4,0)="ADMINISTRATION SCHEDULE file (#51.1): "
16 S PSG(5,0)=" ",PSJSCHD="",OCNT=5,X=""
17 F S PSJSCHD=$O(^XTMP("PSJSC","NSS",PSJSCHD)) Q:PSJSCHD="" S X=X_PSJSCHD_", " I $L(X)>60 S OCNT=OCNT+1,PSG(OCNT,0)=X,X=""
18 I X]"" S OCNT=OCNT+1,PSG(OCNT,0)=X
19 D ^XMD
20 K PSG S XMDUZ="MEDICATIONS,INPATIENT",XMSUB="DANGEROUS SCHEDULES IN 51.1",XMTEXT="PSG(",XMY(DUZ)=""
21 S PSG(1,0)=" The check of Inpatient Medications 5.0 orders is complete."
22 S PSG(3,0)=" ",PSG(4,0)="Here is the list of administration schedules in 51.1",PSG(5,0)="considered 'dangerous': "
23 S PSG(6,0)=" ",PSJSCHD="",OCNT=6,X=""
24 F S PSJSCHD=$O(^XTMP("PSJSC","DAN51.1",PSJSCHD)) Q:PSJSCHD="" S X=X_PSJSCHD_", " I $L(X)>60 S OCNT=OCNT+1,PSG(OCNT,0)=X,X=""
25 I X]"" S OCNT=OCNT+1,PSG(OCNT,0)=X
26 D ^XMD
27 K PSG S XMDUZ="MEDICATIONS,INPATIENT",XMSUB="DANGEROUS SCHEDULE ABBREVIATIONS",XMTEXT="PSG(",XMY(DUZ)=""
28 S PSG(1,0)=" The check of Inpatient Medications 5.0 orders is complete."
29 S PSG(2,0)=" ",PSG(3,0)="Here is the list of administration schedules JCAHO labels",PSG(4,0)="as dangerous: "
30 S PSG(5,0)=" ",PSJSCHD="",OCNT=5,X=""
31 F S PSJSCHD=$O(^XTMP("PSJSC","DAN",PSJSCHD)) Q:PSJSCHD="" S X=X_PSJSCHD_", " I $L(X)>60 S OCNT=OCNT+1,PSG(OCNT,0)=X,X=""
32 I X]"" S OCNT=OCNT+1,PSG(OCNT,0)=X
33 D ^XMD
34 K PSG S XMDUZ="MEDICATIONS,INPATIENT",XMSUB="NON-STANDARD SCHEDULES IN QUICK CODES",XMTEXT="PSG(",XMY(DUZ)=""
35 S PSG(1,0)=" The check of Inpatient Medications 5.0 is complete."
36 S PSG(2,0)=" ",PSG(3,0)="Here is the list of IV Additives / IV Quick Codes with non-standard schedules:"
37 S PSG(4,0)=" ",A="",OCNT=4,X=""
38 F S A=$O(^XTMP("PSJSC","QC","NSS",A)) Q:A="" S X=X_A_", " I $L(X)>60 S OCNT=OCNT+1,PSG(OCNT,0)=X,X=""
39 I X]"" S OCNT=OCNT+1,PSG(OCNT,0)=X
40 D ^XMD
41 K PSG S XMDUZ="MEDICATIONS,INPATIENT",XMSUB="DANGEROUS SCHEDULES IN QUICK CODES",XMTEXT="PSG(",XMY(DUZ)=""
42 S PSG(1,0)=" The check of Inpatient Medications 5.0 is complete."
43 S PSG(2,0)=" ",PSG(3,0)="Here is the list of IV Additives / IV Quick Codes with dangerous abbreviations:"
44 S PSG(4,0)=" ",A="",OCNT=4,X=""
45 F S A=$O(^XTMP("PSJSC","QC","DAN",A)) Q:A="" S X=X_A_", " I $L(X)>60 S OCNT=OCNT+1,PSG(OCNT,0)=X,X=""
46 I X]"" S OCNT=OCNT+1,PSG(OCNT,0)=X
47 D ^XMD
48 K PSG S XMDUZ="MEDICATIONS,INPATIENT",XMSUB="NON-STANDARD SCHEDULES IN ORDER SETS",XMTEXT="PSG(",XMY(DUZ)=""
49 S PSG(1,0)=" The check of Inpatient Medications 5.0 is complete."
50 S PSG(2,0)=" ",PSG(3,0)="Here is the list of Unit Dose Order Sets with non-standard schedules:"
51 S PSG(4,0)=" ",A="",OCNT=4,X=""
52 F S A=$O(^XTMP("PSJSC","OS","NSS",A)) Q:A="" S X=X_A_", " I $L(X)>60 S OCNT=OCNT+1,PSG(OCNT,0)=X,X=""
53 I X]"" S OCNT=OCNT+1,PSG(OCNT,0)=X
54 D ^XMD
55 K PSG S XMDUZ="MEDICATIONS,INPATIENT",XMSUB="DANGEROUS SCHEDULES IN ORDER SETS",XMTEXT="PSG(",XMY(DUZ)=""
56 S PSG(1,0)=" The check of Inpatient Medications 5.0 is complete."
57 S PSG(2,0)=" ",PSG(3,0)="Here is the list of Unit Dose Order Sets with dangerous abbreviations:"
58 S PSG(4,0)=" ",A="",OCNT=4,X=""
59 F S A=$O(^XTMP("PSJSC","OS","DAN",A)) Q:A="" S X=X_A_", " I $L(X)>60 S OCNT=OCNT+1,PSG(OCNT,0)=X,X=""
60 I X]"" S OCNT=OCNT+1,PSG(OCNT,0)=X
61 D ^XMD
62 K PSG S XMDUZ="MEDICATIONS,INPATIENT",XMSUB="NON-STANDARD SCHEDULES IN ORDERABLE ITEMS",XMTEXT="PSG(",XMY(DUZ)=""
63 S PSG(1,0)=" The check of Inpatient Medications 5.0 is complete."
64 S PSG(2,0)=" ",PSG(3,0)="Here is the list of Orderable Items-Dosage Forms with dangerous abbreviations:"
65 S PSG(4,0)=" ",A="",OCNT=4,X=""
66 F S A=$O(^XTMP("PSJSC","OI","NSS",A)) Q:A="" S X=X_A_"-"_^(A)_", " I $L(X)>60 S OCNT=OCNT+1,PSG(OCNT,0)=X,X=""
67 I X]"" S OCNT=OCNT+1,PSG(OCNT,0)=X
68 D ^XMD
69 K PSG S XMDUZ="MEDICATIONS,INPATIENT",XMSUB="DANGEROUS SCHEDULES IN ORDERABLE ITEMS",XMTEXT="PSG(",XMY(DUZ)=""
70 S PSG(1,0)=" The check of Inpatient Medications 5.0 is complete."
71 S PSG(2,0)=" ",PSG(3,0)="Here is the list of Orderable Items-Dosage Forms with dangerous abbreviations:"
72 S PSG(4,0)=" ",A="",OCNT=4,X=""
73 F S A=$O(^XTMP("PSJSC","OI","DAN",A)) Q:A="" S X=X_A_"-"_^(A)_", " I $L(X)>60 S OCNT=OCNT+1,PSG(OCNT,0)=X,X=""
74 I X]"" S OCNT=OCNT+1,PSG(OCNT,0)=X
75 D ^XMD
76 Q
Note: See TracBrowser for help on using the repository browser.