PSJA0103.m

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

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