PSJA0103 ;BIR/JLC - Check for Non-Standard Schedules ;01-MAR-04
;;5.0; INPATIENT MEDICATIONS ;**103**;16 DEC 97
;
SENDMSG ;
D NOW^%DTC S (Y,YA)=% X ^DD("DD") S YT=Y
K PSG,XMY S XMDUZ="MEDICATIONS,INPATIENT",XMSUB="ADMIN SCHEDULES",XMTEXT="PSG(",XMY(DUZ)=""
S PSG(1,0)=" The check of Inpatient Medications 5.0 orders is complete."
S PSG(2,0)=" ",PSG(3,0)=" Here is the list of all medication administration schedules in use: ",PSG(4,0)=" "
S PSJSCHD="",OCNT=4,X=""
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=""
I X]"" S OCNT=OCNT+1,PSG(OCNT,0)=X
D ^XMD
K PSG S XMDUZ="MEDICATIONS,INPATIENT",XMSUB="ADMIN SCHEDULES NOT IN 51.1",XMTEXT="PSG(",XMY(DUZ)=""
S PSG(1,0)=" The check of Inpatient Medications 5.0 orders is complete."
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): "
S PSG(5,0)=" ",PSJSCHD="",OCNT=5,X=""
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=""
I X]"" S OCNT=OCNT+1,PSG(OCNT,0)=X
D ^XMD
K PSG S XMDUZ="MEDICATIONS,INPATIENT",XMSUB="DANGEROUS SCHEDULES IN 51.1",XMTEXT="PSG(",XMY(DUZ)=""
S PSG(1,0)=" The check of Inpatient Medications 5.0 orders is complete."
S PSG(3,0)=" ",PSG(4,0)="Here is the list of administration schedules in 51.1",PSG(5,0)="considered 'dangerous': "
S PSG(6,0)=" ",PSJSCHD="",OCNT=6,X=""
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=""
I X]"" S OCNT=OCNT+1,PSG(OCNT,0)=X
D ^XMD
K PSG S XMDUZ="MEDICATIONS,INPATIENT",XMSUB="DANGEROUS SCHEDULE ABBREVIATIONS",XMTEXT="PSG(",XMY(DUZ)=""
S PSG(1,0)=" The check of Inpatient Medications 5.0 orders is complete."
S PSG(2,0)=" ",PSG(3,0)="Here is the list of administration schedules JCAHO labels",PSG(4,0)="as dangerous: "
S PSG(5,0)=" ",PSJSCHD="",OCNT=5,X=""
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=""
I X]"" S OCNT=OCNT+1,PSG(OCNT,0)=X
D ^XMD
K PSG S XMDUZ="MEDICATIONS,INPATIENT",XMSUB="NON-STANDARD SCHEDULES IN QUICK CODES",XMTEXT="PSG(",XMY(DUZ)=""
S PSG(1,0)=" The check of Inpatient Medications 5.0 is complete."
S PSG(2,0)=" ",PSG(3,0)="Here is the list of IV Additives / IV Quick Codes with non-standard schedules:"
S PSG(4,0)=" ",A="",OCNT=4,X=""
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=""
I X]"" S OCNT=OCNT+1,PSG(OCNT,0)=X
D ^XMD
K PSG S XMDUZ="MEDICATIONS,INPATIENT",XMSUB="DANGEROUS SCHEDULES IN QUICK CODES",XMTEXT="PSG(",XMY(DUZ)=""
S PSG(1,0)=" The check of Inpatient Medications 5.0 is complete."
S PSG(2,0)=" ",PSG(3,0)="Here is the list of IV Additives / IV Quick Codes with dangerous abbreviations:"
S PSG(4,0)=" ",A="",OCNT=4,X=""
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=""
I X]"" S OCNT=OCNT+1,PSG(OCNT,0)=X
D ^XMD
K PSG S XMDUZ="MEDICATIONS,INPATIENT",XMSUB="NON-STANDARD SCHEDULES IN ORDER SETS",XMTEXT="PSG(",XMY(DUZ)=""
S PSG(1,0)=" The check of Inpatient Medications 5.0 is complete."
S PSG(2,0)=" ",PSG(3,0)="Here is the list of Unit Dose Order Sets with non-standard schedules:"
S PSG(4,0)=" ",A="",OCNT=4,X=""
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=""
I X]"" S OCNT=OCNT+1,PSG(OCNT,0)=X
D ^XMD
K PSG S XMDUZ="MEDICATIONS,INPATIENT",XMSUB="DANGEROUS SCHEDULES IN ORDER SETS",XMTEXT="PSG(",XMY(DUZ)=""
S PSG(1,0)=" The check of Inpatient Medications 5.0 is complete."
S PSG(2,0)=" ",PSG(3,0)="Here is the list of Unit Dose Order Sets with dangerous abbreviations:"
S PSG(4,0)=" ",A="",OCNT=4,X=""
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=""
I X]"" S OCNT=OCNT+1,PSG(OCNT,0)=X
D ^XMD
K PSG S XMDUZ="MEDICATIONS,INPATIENT",XMSUB="NON-STANDARD SCHEDULES IN ORDERABLE ITEMS",XMTEXT="PSG(",XMY(DUZ)=""
S PSG(1,0)=" The check of Inpatient Medications 5.0 is complete."
S PSG(2,0)=" ",PSG(3,0)="Here is the list of Orderable Items-Dosage Forms with dangerous abbreviations:"
S PSG(4,0)=" ",A="",OCNT=4,X=""
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=""
I X]"" S OCNT=OCNT+1,PSG(OCNT,0)=X
D ^XMD
K PSG S XMDUZ="MEDICATIONS,INPATIENT",XMSUB="DANGEROUS SCHEDULES IN ORDERABLE ITEMS",XMTEXT="PSG(",XMY(DUZ)=""
S PSG(1,0)=" The check of Inpatient Medications 5.0 is complete."
S PSG(2,0)=" ",PSG(3,0)="Here is the list of Orderable Items-Dosage Forms with dangerous abbreviations:"
S PSG(4,0)=" ",A="",OCNT=4,X=""
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=""
I X]"" S OCNT=OCNT+1,PSG(OCNT,0)=X
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJA0103 5039 printed Sep 23, 2025@19:42:10 Page 2
PSJA0103 ;BIR/JLC - Check for Non-Standard Schedules ;01-MAR-04
+1 ;;5.0; INPATIENT MEDICATIONS ;**103**;16 DEC 97
+2 ;
SENDMSG ;
+1 DO NOW^%DTC
SET (Y,YA)=%
XECUTE ^DD("DD")
SET YT=Y
+2 KILL PSG,XMY
SET XMDUZ="MEDICATIONS,INPATIENT"
SET XMSUB="ADMIN SCHEDULES"
SET XMTEXT="PSG("
SET XMY(DUZ)=""
+3 SET PSG(1,0)=" The check of Inpatient Medications 5.0 orders is complete."
+4 SET PSG(2,0)=" "
SET PSG(3,0)=" Here is the list of all medication administration schedules in use: "
SET PSG(4,0)=" "
+5 SET PSJSCHD=""
SET OCNT=4
SET X=""
+6 FOR
SET PSJSCHD=$ORDER(^XTMP("PSJSC","ALL",PSJSCHD))
if PSJSCHD=""
QUIT
SET X=X_PSJSCHD_", "
IF $LENGTH(X)>60
SET OCNT=OCNT+1
SET PSG(OCNT,0)=X
SET X=""
+7 IF X]""
SET OCNT=OCNT+1
SET PSG(OCNT,0)=X
+8 DO ^XMD
+9 KILL PSG
SET XMDUZ="MEDICATIONS,INPATIENT"
SET XMSUB="ADMIN SCHEDULES NOT IN 51.1"
SET XMTEXT="PSG("
SET XMY(DUZ)=""
+10 SET PSG(1,0)=" The check of Inpatient Medications 5.0 orders is complete."
+11 SET PSG(2,0)=" "
SET PSG(3,0)="Here is the list of administration schedules not in the"
SET PSG(4,0)="ADMINISTRATION SCHEDULE file (#51.1): "
+12 SET PSG(5,0)=" "
SET PSJSCHD=""
SET OCNT=5
SET X=""
+13 FOR
SET PSJSCHD=$ORDER(^XTMP("PSJSC","NSS",PSJSCHD))
if PSJSCHD=""
QUIT
SET X=X_PSJSCHD_", "
IF $LENGTH(X)>60
SET OCNT=OCNT+1
SET PSG(OCNT,0)=X
SET X=""
+14 IF X]""
SET OCNT=OCNT+1
SET PSG(OCNT,0)=X
+15 DO ^XMD
+16 KILL PSG
SET XMDUZ="MEDICATIONS,INPATIENT"
SET XMSUB="DANGEROUS SCHEDULES IN 51.1"
SET XMTEXT="PSG("
SET XMY(DUZ)=""
+17 SET PSG(1,0)=" The check of Inpatient Medications 5.0 orders is complete."
+18 SET PSG(3,0)=" "
SET PSG(4,0)="Here is the list of administration schedules in 51.1"
SET PSG(5,0)="considered 'dangerous': "
+19 SET PSG(6,0)=" "
SET PSJSCHD=""
SET OCNT=6
SET X=""
+20 FOR
SET PSJSCHD=$ORDER(^XTMP("PSJSC","DAN51.1",PSJSCHD))
if PSJSCHD=""
QUIT
SET X=X_PSJSCHD_", "
IF $LENGTH(X)>60
SET OCNT=OCNT+1
SET PSG(OCNT,0)=X
SET X=""
+21 IF X]""
SET OCNT=OCNT+1
SET PSG(OCNT,0)=X
+22 DO ^XMD
+23 KILL PSG
SET XMDUZ="MEDICATIONS,INPATIENT"
SET XMSUB="DANGEROUS SCHEDULE ABBREVIATIONS"
SET XMTEXT="PSG("
SET XMY(DUZ)=""
+24 SET PSG(1,0)=" The check of Inpatient Medications 5.0 orders is complete."
+25 SET PSG(2,0)=" "
SET PSG(3,0)="Here is the list of administration schedules JCAHO labels"
SET PSG(4,0)="as dangerous: "
+26 SET PSG(5,0)=" "
SET PSJSCHD=""
SET OCNT=5
SET X=""
+27 FOR
SET PSJSCHD=$ORDER(^XTMP("PSJSC","DAN",PSJSCHD))
if PSJSCHD=""
QUIT
SET X=X_PSJSCHD_", "
IF $LENGTH(X)>60
SET OCNT=OCNT+1
SET PSG(OCNT,0)=X
SET X=""
+28 IF X]""
SET OCNT=OCNT+1
SET PSG(OCNT,0)=X
+29 DO ^XMD
+30 KILL PSG
SET XMDUZ="MEDICATIONS,INPATIENT"
SET XMSUB="NON-STANDARD SCHEDULES IN QUICK CODES"
SET XMTEXT="PSG("
SET XMY(DUZ)=""
+31 SET PSG(1,0)=" The check of Inpatient Medications 5.0 is complete."
+32 SET PSG(2,0)=" "
SET PSG(3,0)="Here is the list of IV Additives / IV Quick Codes with non-standard schedules:"
+33 SET PSG(4,0)=" "
SET A=""
SET OCNT=4
SET X=""
+34 FOR
SET A=$ORDER(^XTMP("PSJSC","QC","NSS",A))
if A=""
QUIT
SET X=X_A_", "
IF $LENGTH(X)>60
SET OCNT=OCNT+1
SET PSG(OCNT,0)=X
SET X=""
+35 IF X]""
SET OCNT=OCNT+1
SET PSG(OCNT,0)=X
+36 DO ^XMD
+37 KILL PSG
SET XMDUZ="MEDICATIONS,INPATIENT"
SET XMSUB="DANGEROUS SCHEDULES IN QUICK CODES"
SET XMTEXT="PSG("
SET XMY(DUZ)=""
+38 SET PSG(1,0)=" The check of Inpatient Medications 5.0 is complete."
+39 SET PSG(2,0)=" "
SET PSG(3,0)="Here is the list of IV Additives / IV Quick Codes with dangerous abbreviations:"
+40 SET PSG(4,0)=" "
SET A=""
SET OCNT=4
SET X=""
+41 FOR
SET A=$ORDER(^XTMP("PSJSC","QC","DAN",A))
if A=""
QUIT
SET X=X_A_", "
IF $LENGTH(X)>60
SET OCNT=OCNT+1
SET PSG(OCNT,0)=X
SET X=""
+42 IF X]""
SET OCNT=OCNT+1
SET PSG(OCNT,0)=X
+43 DO ^XMD
+44 KILL PSG
SET XMDUZ="MEDICATIONS,INPATIENT"
SET XMSUB="NON-STANDARD SCHEDULES IN ORDER SETS"
SET XMTEXT="PSG("
SET XMY(DUZ)=""
+45 SET PSG(1,0)=" The check of Inpatient Medications 5.0 is complete."
+46 SET PSG(2,0)=" "
SET PSG(3,0)="Here is the list of Unit Dose Order Sets with non-standard schedules:"
+47 SET PSG(4,0)=" "
SET A=""
SET OCNT=4
SET X=""
+48 FOR
SET A=$ORDER(^XTMP("PSJSC","OS","NSS",A))
if A=""
QUIT
SET X=X_A_", "
IF $LENGTH(X)>60
SET OCNT=OCNT+1
SET PSG(OCNT,0)=X
SET X=""
+49 IF X]""
SET OCNT=OCNT+1
SET PSG(OCNT,0)=X
+50 DO ^XMD
+51 KILL PSG
SET XMDUZ="MEDICATIONS,INPATIENT"
SET XMSUB="DANGEROUS SCHEDULES IN ORDER SETS"
SET XMTEXT="PSG("
SET XMY(DUZ)=""
+52 SET PSG(1,0)=" The check of Inpatient Medications 5.0 is complete."
+53 SET PSG(2,0)=" "
SET PSG(3,0)="Here is the list of Unit Dose Order Sets with dangerous abbreviations:"
+54 SET PSG(4,0)=" "
SET A=""
SET OCNT=4
SET X=""
+55 FOR
SET A=$ORDER(^XTMP("PSJSC","OS","DAN",A))
if A=""
QUIT
SET X=X_A_", "
IF $LENGTH(X)>60
SET OCNT=OCNT+1
SET PSG(OCNT,0)=X
SET X=""
+56 IF X]""
SET OCNT=OCNT+1
SET PSG(OCNT,0)=X
+57 DO ^XMD
+58 KILL PSG
SET XMDUZ="MEDICATIONS,INPATIENT"
SET XMSUB="NON-STANDARD SCHEDULES IN ORDERABLE ITEMS"
SET XMTEXT="PSG("
SET XMY(DUZ)=""
+59 SET PSG(1,0)=" The check of Inpatient Medications 5.0 is complete."
+60 SET PSG(2,0)=" "
SET PSG(3,0)="Here is the list of Orderable Items-Dosage Forms with dangerous abbreviations:"
+61 SET PSG(4,0)=" "
SET A=""
SET OCNT=4
SET X=""
+62 FOR
SET A=$ORDER(^XTMP("PSJSC","OI","NSS",A))
if A=""
QUIT
SET X=X_A_"-"_^(A)_", "
IF $LENGTH(X)>60
SET OCNT=OCNT+1
SET PSG(OCNT,0)=X
SET X=""
+63 IF X]""
SET OCNT=OCNT+1
SET PSG(OCNT,0)=X
+64 DO ^XMD
+65 KILL PSG
SET XMDUZ="MEDICATIONS,INPATIENT"
SET XMSUB="DANGEROUS SCHEDULES IN ORDERABLE ITEMS"
SET XMTEXT="PSG("
SET XMY(DUZ)=""
+66 SET PSG(1,0)=" The check of Inpatient Medications 5.0 is complete."
+67 SET PSG(2,0)=" "
SET PSG(3,0)="Here is the list of Orderable Items-Dosage Forms with dangerous abbreviations:"
+68 SET PSG(4,0)=" "
SET A=""
SET OCNT=4
SET X=""
+69 FOR
SET A=$ORDER(^XTMP("PSJSC","OI","DAN",A))
if A=""
QUIT
SET X=X_A_"-"_^(A)_", "
IF $LENGTH(X)>60
SET OCNT=OCNT+1
SET PSG(OCNT,0)=X
SET X=""
+70 IF X]""
SET OCNT=OCNT+1
SET PSG(OCNT,0)=X
+71 DO ^XMD
+72 QUIT
