10:03 AM  15-JAN-2002
VA PSJ*3.2*28 & PSGW*2.2*1 PRE V4.0 PATCH
APSGIOU
APSGIOU ;IHS/ITSC/ENM - STUFF IOU IN DRUG FILE [ 01/14/2002  10:42 AM ]
 ;;3.2;INPATIENT MEDICATIONS;**3**;12/28/01
 D CREATE
 D EXREF
 W !,".......Done!",!
 Q
CREATE ;Create Application Package Use settings for each local drug
 S IFN=0
 W !,"One Moment Please!  I need to create 'Application Package Use' settings for all of your local drugs.....",!
 H 4
 F  S IFN=$O(^PSDRUG(IFN)) Q:'IFN  D P1
 W !,"Done!",!
 Q
P1 ;
 S APSID=$G(^PSDRUG(IFN,"I")) ;INACTIVE DRUG CHECK
 Q:+APSID
 S $P(^PSDRUG(IFN,2),"^",3)="IOU",^PSDRUG("IU","IOU",IFN)=""
 Q
EXREF ;
 ;NEXT LINE WILL REINDEX THE 'IU and AIU' XREF's ON FLD 63 IN FILE 50
 W !,"Re-indexing the 'IU', 'AIUI', 'AIUO' and 'AIUU' cross-references",!,"in your Drug File...",!
 K ^PSDRUG("IU"),^PSDRUG("AIUI"),^PSDRUG("AIUO"),^PSDRUG("AIUU")
 S DIK="^PSDRUG(",DIK(1)="63^IU^AIU" D ENALL^DIK K DIK
 W !,?20,"Re-Indexing Done!",!
 Q
LIST ;LIST LOCAL DRUGS WITH IOU IN 'IU' XREF
 S IFN=0,CT=1
 F  S IFN=$O(^PSDRUG("IU","OI",IFN))  Q:'IFN  S DNAME=$P(^PSDRUG(IFN,0),"^",1) D CK
 Q
CK S ND=$G(^PSDRUG(IFN,"ND"))
 I ND]"" S NDFIRN=+$P(^("ND"),"^",1),NDNAM=$P(^PSNDF(NDFIRN,0),"^")
 I ND]"" W !,CT,?5,IFN,?15,NDNAM S CT=CT+1
 Q

APSGMSG
APSGMSG ;IHS/DSD/ENM - INPATIENT MEDS PATCH 28 MSG ; [ 01/15/2002  9:48 AM ]
 ;;3.2;INPATIENT MEDICATIONS;**3**;12/28/01
MSG ;SETUP AND SEND EMAIL MSG
 W !,"Now I will send a mail message to all holders of the pharmacy 'PSJI MGR' KEY.",!
 D XMSET
 D TEXT
 D MSG1
 D ZAAP
 Q
XMSET ;SET MAIL VARIABLES
 K XMY S XMSUB="Pre-Release Set-Up for Inpatient Meds V4.0 & V4.5.",XMDUZ="PHARMACY SOFTWARE DEVELOPMENT"
 D RPH
 Q
MSG1 D ^XMD K APSPMSG
 Q
TEXT S APSPMSG(1,0)="To:   Inpatient Pharmacy (IP) Supervisors"
 S APSPMSG(2,0)=" "
 S APSPMSG(3,0)="      Pre-Release Set-Up for Inpatient Medications Version 4.0 and 4.5."
 S APSPMSG(4,0)=" "
 S APSPMSG(9,0)="Primary Drugs "
 S APSPMSG(10,0)=""
 S APSPMSG(11,0)="A Primary Drug is a drug that (usually) has no strength or dosage form"
 S APSPMSG(12,0)="associated with it. The Primary Drug was designed to make it easier for"
 S APSPMSG(13,0)="providers to enter medication orders while letting the pharmacist select"
 S APSPMSG(14,0)="the actual drug product that should be dispensed. Drugs that are in the"
 S APSPMSG(15,0)="regular drug file are referred to as Dispense Drugs."
 S APSPMSG(16,0)=""
 S APSPMSG(17,0)="The example below shows an Inpatient Medication Profile. You can see that"
 S APSPMSG(18,0)="the profile displays the Primary Drug name, e.g., LISINOPRIL. Medication"
 S APSPMSG(19,0)="Administration Reports or MARs also print the Primary Drug name instead"
 S APSPMSG(20,0)="of the Dispense Drug name."
 S APSPMSG(21,0)=""
 S APSPMSG(22,0)="I N P A T I E N T   M E D I C A T I O N S       12/10/01  15:42"
 S APSPMSG(23,0)=""
 S APSPMSG(24,0)="- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -"
 S APSPMSG(25,0)="DEMO,PATIENT NMN              Ward: ICU"
 S APSPMSG(26,0)=" HRN: 00-00-01            Room-Bed: 216-2        Ht(cm): ______ (________)"
 S APSPMSG(27,0)=" DOB: 08/25/58  (43)                             Wt(kg): ______ (________)"
 S APSPMSG(28,0)="ex: MALE                                      Admitted: 06/19/00"
 S APSPMSG(29,0)=" Dx: UNKNOWN "
 S APSPMSG(30,0)="Allergies: ASPIRIN/OXYCODONE"
 S APSPMSG(31,0)="      ADR: PROCHLORPERAZINE"
 S APSPMSG(32,0)=" - - - - - - - - - - - - - - - A C T I V E - - - - - - - - - - - - - - - - -"
 S APSPMSG(33,0)="  1     LISINOPRIL                               C  11/2 A"
 S APSPMSG(34,0)="          Give: 20MG PO QD"
 S APSPMSG(35,0)="  2     IBUPROFEN                                P  11/20  12/20  A "
 S APSPMSG(36,0)="          Give: 400MG PO QID"
 S APSPMSG(37,0)="         PRN PAIN"
 S APSPMSG(38,0)="  3     PROCHLORPERAZINE                         P  11/20  12/20  A   HSM"
 S APSPMSG(39,0)="          Give: 10MG (2X5MG) PO Q4H PRN "
 S APSPMSG(40,0)="         NAUSEA/VOMITING "
 S APSPMSG(41,0)=""
 S APSPMSG(42,0)=""
 S APSPMSG(43,0)="It is best to create a separate Primary Drug for drugs that come in"
 S APSPMSG(44,0)="different % solutions such as Dextrose 5%, Dextrose 10%, etc. to prevent"
 S APSPMSG(45,0)="confusion that might result in a medication error."
 S APSPMSG(46,0)=""
 S APSPMSG(47,0)=""
 S APSPMSG(48,0)="Getting Ready to Set Up the Primary Drug File"
 S APSPMSG(49,0)=""
 S APSPMSG(50,0)=""
 S APSPMSG(51,0)="In order to save time later, it is recommended that the pharmacy staff"
 S APSPMSG(52,0)="make sure that unit dose drugs are entered into the Drug File prior to"
 S APSPMSG(53,0)="creating a Primary Drug File. Sites that purchase bulk bottles of tablets"
 S APSPMSG(54,0)="or capsules and repackage them into unit dose containers may decide to use"
 S APSPMSG(55,0)="the same drug entry for both Inpatient and Outpatient Medications. Another"
 S APSPMSG(56,0)="alternative is to create a separate entry for the repackaged unit dose"
 S APSPMSG(57,0)="product, e.g., Amoxicillin 250mg Cap U/D. Separate entries should be"
 S APSPMSG(58,0)="created for all drugs that come in Unit Dose packaging from the"
 S APSPMSG(59,0)="manufacturer so that correct NDC numbers and cost information can be"
 S APSPMSG(60,0)="entered into the Drug File."
 S APSPMSG(61,0)=""
 S APSPMSG(62,0)=""
 S APSPMSG(63,0)="Inpatient Medications Patch 3"
 S APSPMSG(64,0)=""
 S APSPMSG(65,0)="This patch will create a new menu for all pharmacists who hold the"
 S APSPMSG(66,0)="PSJI MGR security key. To access this menu, go to PSJI MGR 'IV Menu'"
 S APSPMSG(67,0)="The new menu contains several options that must be run in order to"
 S APSPMSG(68,0)="create a Primary Drug File. The Primary Drug File needs to be completed"
 S APSPMSG(69,0)="in order to be able to install Inpatient Medications v4.5. The Inpatient"
 S APSPMSG(70,0)="Medications v4.5 package contains both IV Medications and Unit Dose "
 S APSPMSG(71,0)="Medications."
 S APSPMSG(72,0)=""
 S APSPMSG(73,0)="This is what the new menu created by Inpatient Medications Patch 3 will"
 S APSPMSG(74,0)="look like:"
 S APSPMSG(75,0)=""
 S APSPMSG(76,0)="Inpatient Meds V4 Pre-Release Menu"
 S APSPMSG(77,0)=""
 S APSPMSG(78,0)=" 1      Auto-Create Print"
 S APSPMSG(79,0)=" 2      Auto-Create Primary Drug"
 S APSPMSG(80,0)=" 3      Drug Print"
 S APSPMSG(81,0)=" 4      Create Primary Drug (Manual)"
 S APSPMSG(82,0)=" 5      Synonym Move From Drug File To Primary Drug File"
 S APSPMSG(83,0)=" 6      Edit Primary Drug "
 S APSPMSG(84,0)=" 7      Inpatient Site Print"
 S APSPMSG(85,0)=" 8      Move Inpatient Site To Inpatient Ward "
 S APSPMSG(86,0)=" 9      Move Inpatient Site To Ward Group"
 S APSPMSG(87,0)=" 10     Edit Inpatient Ward Parameters File"
 S APSPMSG(88,0)=" 11     Edit Ward Group Pick List Parameters"
 S APSPMSG(89,0)=" 12     Edit IV Additive Type"
 S APSPMSG(90,0)=" 13     Mark Solutions for use in IV Fluids Order Entry"
 S APSPMSG(91,0)=" 14     Edit Dispense Drug"
 S APSPMSG(92,0)=" 15     IV Drug Matched to Primary Drug Print"
 S APSPMSG(93,0)=" 16     IV Additive Type Print"
 S APSPMSG(94,0)=" 17     IV Fluid Solutions Print"
 S APSPMSG(95,0)=" 18     Primary Drug/Dispense Drug Report"
 S APSPMSG(96,0)=" 19     New Person User Report"
 S APSPMSG(97,0)=" 20     Active Provider Report"
 S APSPMSG(98,0)=" 21     Edit Provider Fields in New Person File"
 S APSPMSG(99,0)=" 22     Edit User Parameters"
 S APSPMSG(99.1,0)=" MUD     Mark/Unmark Items for Unit Dose"
 S APSPMSG(100,0)=""
 S APSPMSG(101,0)="Entering ??? at the Select Inpatient Meds V4 Pre-Release Menu Option"
 S APSPMSG(102,0)="prompt will display information about each option on this menu."
 S APSPMSG(103,0)=""
 S APSPMSG(104,0)="Complete the following steps in the order listed to create a Primary"
 S APSPMSG(105,0)="Drug File:"
 S APSPMSG(106,0)=""
 S APSPMSG(107,0)="1.  Select '2 Auto-Create Primary Drug'."
 S APSPMSG(108,0)=""
 S APSPMSG(109,0)="2.  Select '3 Drug Print' -  This report displays the Drug File entries"
 S APSPMSG(110,0)="    grouped by Primary Drug and may be useful when manually creating"
 S APSPMSG(111,0)="    Primary Drugs."
 S APSPMSG(112,0)="3.  Select '4 Create Primary Drug (Manual)'. The Auto-Create Primary Drug"
 S APSPMSG(113,0)="    option will create a Primary Drug entry for most but not all drugs."
 S APSPMSG(114,0)="    It is critical that pharmacy staff complete the manual creation of"
 S APSPMSG(115,0)="    the Primary Drug file. It doesn't have to be completed all at once,"
 S APSPMSG(116,0)="    but it must be completed and the SITE MANAGER MUST be notified of"
 S APSPMSG(117,0)="    completion as soon as possible."
 S APSPMSG(118,0)="4.  Select '18 Primary Drug/Dispense Drug Report'. Review the report to"
 S APSPMSG(119,0)="    make sure that drugs are matched up to the correct Primary Drug and"
 S APSPMSG(120,0)="    that the Primary Drug name appears correctly. Primary drugs may be"
 S APSPMSG(121,0)="    created for drugs listed as Exceptions (meaning that they do not have"
 S APSPMSG(122,0)="    a Primary Drug) by selecting '6 Edit Primary Drug'. If a drug is"
 S APSPMSG(123,0)="    matched to the wrong Primary Drug, select '14 Edit Dispense Drug' and"
 S APSPMSG(124,0)="    select the correct Primary Drug."
 S APSPMSG(125,0)="5.  Select '5 Synonym Move From Drug File to Primary Drug File'."
 S APSPMSG(125.1,0)="6.  Mark/Unmark Items For Unit Dose"
 S APSPMSG(125.2,0)="When Patch 3 to Inpatient Medications package is first installed,"
 S APSPMSG(125.3,0)="it marks all items in the Drug file for use by Unit Dose so that"
 S APSPMSG(125.4,0)="users may immediately continue to use the package."
 S APSPMSG(126,0)=""
 S APSPMSG(127,0)="Refining the Primary Drug File"
 S APSPMSG(128,0)=""
 S APSPMSG(129,0)="Primary Drugs can be customized as much or as little as desired by each"
 S APSPMSG(130,0)="site. When information such as Medication Route, Schedule Type, or"
 S APSPMSG(131,0)="Schedule is added to the Primary Drug entries, that information will"
 S APSPMSG(132,0)="automatically fill in fields during Unit Dose Medication order entry."
 S APSPMSG(133,0)="This can save a lot of time for the pharmacist entering orders, but"
 S APSPMSG(134,0)="does require some time initially to edit the Primary Drug entries."
 S APSPMSG(135,0)=""
 S APSPMSG(136,0)="Please contact Carlene McIntyre, Pharmacy Consult at (505) 248-4960"
 S APSPMSG(138,0)="if you need assistance."
 S APSPMSG(139,0)=""
 S XMTEXT="APSPMSG(",%H=$H D YX^%DTC
 Q
RPH ;GET HOLDERS OF 'PSORPH' (PHARMACIST)
 ;S XMY("MOORE,EDGAR")="" Q  ;TEMPORARY, REMOVE AFTER TESTING
 ;S XMY("JARAMILLO,LISA")="" Q  ;temporary, remark out after testing
 S J=0
 ;select holders of the PSJI MGR key
 F J=0:0 S J=$O(^XUSEC("PSJI MGR",J)) Q:'J  S APSPNAME=$P($G(^VA(200,J,0)),"^"),XMY(APSPNAME)=""
 Q
ZAAP ;KILL ALL VARIABLES ON EXIT
 K APSLNAME,APSP,APSPDG,APSPZ,XMDUZ,J,X,XMSUB,XMTEXT
 Q

APSGPAC
APSGPAC ;IHS/DSD/ENM - POST UTILITY ; [ 12/28/2001  9:48 AM ]
 ;;3.2;INPATIENT MEDICATIONS;**3**;12/28/01
 W !,"Running Post Routines that will............."
 W !!,"- Create Application Package Use Settings....."
 W !!,"- Create Inpatient Meds V4 Pre-Release Menu....."
 W !!,"- And...Send a Mail Message to all IV Managers....",!
 H 3
 D ^APSGPOST ;Add PSJI MGR Menu Option to IV Manager's menu
 D ^APSGIOU ;Stuff 'IOU' setting for all 'Active' Drugs
 D ^APSGMSG ;Send a Mail Message to all IV Managers
 W !!,"*** I'm Done ***"
 Q

APSGPOST
APSGPOST ; IHS/DSD/ENM - ADD P28 OPTIONS TO IV MENU'S ;  [ 01/14/2002  3:19 PM ]
 ;;3.2;INPATIENT MEDICATIONS;**3**;12/28/01
EP ;
 W !!,"Now, I'm going to add the following menu options to the 'PSJI MGR'",!,"Menu Option",!,?10,"PSJ4 MGR - Inpatient Meds V4 Pre-Release Menu"
 W !!,?10,"and PSJU MARK UD ITEMS Option added to PSJ4 MGR Menu",!
 W !,?10,"........One moment please!",!! H 3
 S M1="PSJI MGR"
 ;GET FILE 19 DETAILS FOR OPTIONS
 S DIC("P")=$P(^DD(19,10,0),"^",2) ;GET MENU SUB FILE NBR
 S DA=$O(^DIC(19,"B","PSJ4 MGR",0)) ;item rec nbr
 S DIC("DR")="2///PRE4" ;synonym
 S DA(1)=$O(^DIC(19,"B","PSJI MGR",0)) ;main option nbr
 D PT1
 ;
 S M1="PSJ4 MGR"
 S DIC("P")=$P(^DD(19,10,0),"^",2) ;GET MENU SUB FILE NBR
 S DA=$O(^DIC(19,"B","PSJU MARK UD ITEMS",0)) ;item rec nbr
 S DIC("DR")="2///MUD" ;synonym
 S DA(1)=$O(^DIC(19,"B","PSJ4 MGR",0)) ;main option nbr
 D PT1
 W !!,"OK, I'm done!",!!
 Q
PT1 Q:DA=""
 S APSPN=$P(^DIC(19,DA,0),"^",1) ;name of item option
 I 'DA(1) W !!,*7,*7,"*** The "_APSPN_" option has not been added to the"_M1_" menu",!,"    because the "_M1_" menu does not exist on your system. Install"
 I  W !,"    the "_M1_" menu then rerun this routine again." G EX
 S THERE=$O(^DIC(19,DA(1),10,"B",DA,0))
 I THERE W !,*7,*7,"The "_APSPN_" option has already been added to the "_M1_" menu.",!! G EX
 S X=DA,DIC="^DIC(19,"_DA(1)_",10,",DIC(0)="LMZ" K DD,DO D FILE^DICN K DIC
 W !,APSPN_" Option added to "_M1_" menu!"
EX K DA,THERE,X,Y,APSPN Q
 Q

PSGPO
PSGPO ;IHS/DSD/ENM/B'ham ISC/CML3 - PURGE PATIENT'S ORDERS ;4/15/91  22:36 [ 04/27/1999  9:50 AM ]
 ;;3.2;INPATIENT MEDICATIONS;**1**;12/04/98
 D ENCV^PSGSETU Q:$D(XQUIT)  S POD=$O(^PS(55,"AUDDD",0)) I 'POD K POD W !!,"THERE ARE NO ORDERS TO PURGE AT THIS TIME." Q
 ;Y2000 beginning Y2K fix...IHS/DSD/ENM 08/21/98
 S EDATE=4000000 D:$S($D(^PS(53.5,"B")):1,1:$D(^("F"))) EDATE I EDATE<4000000 S X1=EDATE\1,X2=-31 D C^%DTC S EDATE=X I POD>EDATE W !!,"THERE ARE PICK LISTS THAT NEED TO BE FILED AWAY THAT MAY CONTAIN THESE ORDERS.",! G DONE
 ;S EDATE=3000000 D:$S($D(^PS(53.5,"B")):1,1:$D(^("F"))) EDATE I EDATE<3000000 S X1=EDATE\1,X2=-31 D C^%DTC S EDATE=X I POD>EDATE W !!,"THERE ARE PICK LISTS THAT NEED TO BE FILED AWAY THAT MAY CONTAIN THESE ORDERS.",! G DONE
 ;Y2000 ending Y2K fix IHS/DSD/ENM 08/21/98
 S PSGID=POD X psgdtc S Y=-1
 ;Y2000 beginning Y2K fix...IHS/DSD/ENM 08/21/98
 F Q=0:0 K %DT S %DT="EPTX" S:EDATE<4000000 %DT(0)=-EDATE R !!,"PURGE ORDERS FOR PATIENTS DISCHARGED BEFORE WHAT DATE: ",X:DTIME W:'$T *7 S:'$T X="^" D DTM:X?1."?",^%DT:"^"'[X I Y>0!("^"[X) W:Y'>0 !,"No date chosen, or orders purged.",! Q
 ;F Q=0:0 K %DT S %DT="EPTX" S:EDATE<3000000 %DT(0)=-EDATE R !!,"PURGE ORDERS FOR PATIENTS DISCHARGED BEFORE WHAT DATE: ",X:DTIME W:'$T *7 S:'$T X="^" D DTM:X?1."?",^%DT:"^"'[X I Y>0!("^"[X) W:Y'>0 !,"No date chosen, or orders purged.",! Q
 ;Y2000 ending Y2K fix IHS/DSD/ENM 08/21/98
 G:Y'>0 DONE W !!,"This purge will automatically be queued." K %ZIS,IO("C"),IO("Q"),IOP S PSGION=ION,%ZIS="NQ",%ZIS("B")="",%ZIS("A")="Please select a DEVICE for the PURGE REPORT: " D ^%ZIS
 I POP S IOP=PSGION D ^%ZIS W !?3,"No device selected, or purge run." G DONE
 S PSGPOD=Y,PSGPOIO=ION K ZTSAVE S ZTDESC="PATIENT ORDER PURGE",PSGTIR="ENQ^PSGPO",(ZTIO,ZTSAVE("PSGPOIO"),ZTSAVE("PSGPOD"))="" D ENTSK^PSGTI W:$D(ZTSK) !,"Purge queued.  (It may take a while to run.)",! G DONE
 ;
ENQ ;
 L ^PS(53.43,1,1,0) S ND=$S($D(^PS(53.43,1,1,0)):^(0),1:"^53.4301A")
 F RDA=$P(ND,"^",3)+1:1 W "." I '$D(^PS(53.43,1,1,RDA)) S ^PS(53.43,1,1,RDA,0)=RDA,$P(ND,"^",3)=RDA,$P(ND,"^",4)=$P(ND,"^",4)+1,^PS(53.43,1,1,0)=ND Q
 F PSGPO=0:0 S PSGPO=$O(^PS(55,"AUDDD",PSGPO)) Q:'PSGPO!(PSGPO'<PSGPOD)  F DA(1)=0:0 S DA(1)=$O(^PS(55,"AUDDD",PSGPO,DA(1))) Q:'DA(1)  F DA=0:0 S DA=$O(^PS(55,"AUDDD",PSGPO,DA(1),DA)) Q:'DA  D DIK
 K %ZIS,ZTSAVE S H=ZTSK,IOP=PSGPOIO,%ZIS="NQ",PSGJ=RDA,PSGTIR="^PSGPOR",ZTDESC="PATIENT ORDER PURGE REPORT",PSGTID=$H,(ZTSAVE("PSGPOD"),ZTSAVE("PSGJ"))="" D ^%ZIS,ENTSK^PSGTI S ZTSK=H
 ;
DONE ;
 D ENKV^PSGSETU K AM,EDATE,H,POD,PSGJ,PSGPO,PSGPOD,PSGPOIO,ST,TRTN,ZTOUT Q
 ;
DIK ;
 S DIK="^PS(55,"_DA(1)_",5," D ^DIK K ^PS(55,DA(1),5,"B",DA,DA),^PS(55,"AUDDD",PSGPO,DA(1),DA),^PS(55,"AUE",DA(1),DA) S ^(0)=DA(1)_"^"_$S($D(^PS(53.43,1,1,RDA,1,DA(1),0)):$P(^(0),"^",2)+1,1:1) Q
 ;
DTM ;
 W !!,"  If a date is entered here, all orders for patients discharged before the date entered will be purged (deleted) from the computer.  Please note that any ordersfor any patients admitted after the date entered will NOT be affected."
 W !,"  The earliest discharge date found is ",PSGOD,! Q
 ;
EDATE ;
 F X=0:0 S X=$O(^PS(53.5,"B",X)) Q:'X  S Y=$O(^(X,0)) I Y,Y<EDATE S EDATE=Y
 F X=0:0 S X=$O(^PS(53.5,"F",X)) Q:'X  I $D(^PS(53.5,X,0)) S Y=$P(^(0),"^",2) I Y,Y<EDATE S EDATE=Y
 Q
 ;
ENRX ; re-index 55 to be able to purge UD orders (AUDDD x-ref)
 K ^PS(55,"AUDDD") D NOW^%DTC F P=0:0 S P=$O(^PS(55,P)) Q:'P  I $D(^(P,5)) D RX1
 K A Q
 ;
RX1 ;
 S (D1,DL)=0 F Q=0:0 S Q=$O(^DPT(P,"DA",Q)) Q:'Q  S AD=$S($D(^(Q,0)):+^(0),1:0),D2=$S($D(^(1)):+^(1),1:0) S:'D2 DL=AD I D2>+D1 S D1=D2_"^"_Q_"^"_AD
 Q:'D1  S:'DL DL=% F Q=0:0 S Q=$O(^PS(55,P,5,"AUS",Q)) Q:'Q  Q:Q>DL  F QQ=0:0 S QQ=$O(^PS(55,P,5,"AUS",Q,QQ)) Q:'QQ  S $P(^PS(55,P,5,QQ,0),"^",20)=+D1,^PS(55,"AUDDD",+D1,P,QQ)=""
 S:$D(^PS(55,"AUDDD",+D1,P)) ^(P)=$P(D1,"^",2,3) Q
 ;
ENDS ; delete single order
 F Q=0:0 R !!,"DO YOU WANT TO CANCEL (DELETE) THIS ORDER" S %=1 D YN^DICN Q:%  W !!?2,"Answer 'Y' to cancel this order now.  (It will be deleted immediately.)",!,"Answer 'N' (or '^') to not cancel the order."
 I %=1 S DA(1)=PSGP,DA=+PSGORD,DIK="^PS(55,"_PSGP_",5,",PSGPO=1 W !?3,"...one moment, please..." D ^DIK K DIK,DA,PSGPO W ".DONE!" S PSGCANFL=1
 K %,%Y Q

PSGWCAD3
PSGWCAD3 ;BHAM ISC/CML-Check for non-pharmacy items in AOUs before updating AMIS Stats ; 12/18/90 14:10 [ 01/03/2002  10:36 AM ]
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 ;;2.2;;**1** Original VA Patch 28
START ;Locate all non-pharmacy items in Drug file
 K APP,AOU,ERR3 S (AOUCNT,DRGCNT)=0
 S APP="" F JJ=0:0 S APP=$O(^PSDRUG("IU",APP)) Q:APP=""  I APP'["O"&(APP'["U")&(APP'["I")&(APP'["N") F DRG=0:0 S DRG=$O(^PSDRUG("IU",APP,DRG)) Q:'DRG  S APP(DRG)="",DRGCNT=DRGCNT+1
AOU ;Check AOUs for non-pharmacy items
 G:'$O(APP(0)) QUIT F AOU=0:0 S AOU=$O(^PSI(58.1,AOU)) Q:'AOU  I $S('$D(^PSI(58.1,AOU,"I")):1,'^("I"):1,^("I")>DT:1,1:0) S AOU(AOU)="",AOUCNT=AOUCNT+1
 G:'$O(AOU(0)) QUIT F AOU=0:0 S AOU=$O(AOU(AOU)) Q:'AOU  F ITM=0:0 S ITM=$O(^PSI(58.1,AOU,1,ITM)) Q:'ITM  S ITMNUM=$P(^PSI(58.1,AOU,1,ITM,0),"^") I $D(APP(ITMNUM)) D CHK
 I $D(ERR3) D MAIL
QUIT K %,%H,%I,AOU,AOUCNT,APP,CNT,DRG,DRGCNT,ERR3,I,INACT,ITM,ITMNUM,J,JJ,K,NUM,PRT1,PRT2,PRT3,PSGWDUZ,RDT,X,XMDUZ,XMKK,XMLOCK,XMR,XMSUB,XMT,XMTEXT,XMY,XMZ,Y,^UTILITY("PSGWMSG",$J) Q
CHK ;Check non-pharmacy items for inactivation date in AOU
 ;ERR3(ITMNUM,AOU)=""
 S INACT=$P(^PSI(58.1,AOU,1,ITM,0),"^",3) I $S('INACT:1,INACT>DT:1,1:0) S ERR3(ITMNUM,AOU)=""
 Q
MAIL ;Send message for non-pharmacy items found in AOUs
 Q:'$O(ERR3(0))  S NUM=6,CNT=0
 K XMY,^UTILITY("PSGWMSG",$J) D NOW^%DTC S Y=X X ^DD("DD") S RDT=Y
 F PSGWDUZ=0:0 S PSGWDUZ=$O(^XUSEC("PSGWMGR",PSGWDUZ)) Q:'PSGWDUZ  S XMY(PSGWDUZ)=""
 I '$D(XMY) F PSGWDUZ=0:0 S PSGWDUZ=$O(^XUSEC("PSGW PARAM",PSGWDUZ)) Q:'PSGWDUZ  S XMY(PSGWDUZ)=""
 S:'$D(XMY) XMY(.5)="" S PRT1=$S(AOUCNT>1:"AOUs",1:"AOU"),PRT2=$S(DRGCNT>1:"items",1:"item"),$P(PRT3,"-",78)=""
 S ^UTILITY("PSGWMSG",$J,1,0)="On "_RDT_", the nightly job to update the AR/WS AMIS Stats file (#58.5)"
 S ^UTILITY("PSGWMSG",$J,2,0)="identified the following "_PRT2_" in the following "_PRT1_" that "_$S(DRGCNT>1:"have",1:"has")_" been marked"
 S ^UTILITY("PSGWMSG",$J,3,0)="in the Drug file (#50) for NON-PHARMACY use.",^UTILITY("PSGWMSG",$J,4,0)=""
 S ^UTILITY("PSGWMSG",$J,5,0)="ITEM           AOU",^UTILITY("PSGWMSG",$J,6,0)=PRT3
 F DRG=0:0 S DRG=$O(ERR3(DRG)) Q:'DRG  S NUM=NUM+1,CNT=CNT+1 S ^UTILITY("PSGWMSG",$J,NUM,0)=CNT_"."_" "_$P(^PSDRUG(DRG,0),"^") F AOU=0:0 S AOU=$O(ERR3(DRG,AOU)) Q:'AOU  D SET
 S NUM=NUM+1,^UTILITY("PSGWMSG",$J,NUM,0)="",NUM=NUM+1,^UTILITY("PSGWMSG",$J,NUM,0)="It will be necessary to either inactivate "_$S(DRGCNT>1:"these ",1:"this ")_PRT2_" in the "_PRT1_" or mark"
 S NUM=NUM+1,^UTILITY("PSGWMSG",$J,NUM,0)="the "_PRT2_" for PHARMACY use in the Drug file.  For further explanation, please"
 S NUM=NUM+1,^UTILITY("PSGWMSG",$J,NUM,0)="refer to item #7 ([PSGW UPDATE AMIS STATS]) under the Supervisor's Menu in"
 S NUM=NUM+1,^UTILITY("PSGWMSG",$J,NUM,0)="the AR/WS version 2.2 USER MANUAL."
 S XMSUB="NON-PHARMACY ITEMS FOUND",XMDUZ="INPATIENT PHARMACY AR/WS",XMTEXT="^UTILITY(""PSGWMSG"",$J," D ^XMD
 Q
SET ;
 S NUM=NUM+1,^UTILITY("PSGWMSG",$J,NUM,0)="               "_$P(^PSI(58.1,AOU,0),"^") Q

PSGWOD2
PSGWOD2 ;BHAM ISC/MPH,PTD,CML-Enter an On-Demand Request (for Pharmacy Use) - CONTINUED ; 09/20/89 10:37 [ 01/03/2002  10:37 AM ]
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 ;;2.2;;**1** Original VA Patch 28
DIENEW S PSGWD=$S('$D(^PSI(58.1,AOU,2,0)):0,$P(^PSI(58.1,AOU,2,0),"^",3)'="":$P(^PSI(58.1,AOU,2,$P(^PSI(58.1,AOU,2,0),"^",3),0),"^",1),1:0)
 S DR(2,58.11)="1///0;30///TODAY;31///O;33///ONE TIME REQ.;16///"_PSGWODT
 ;I %=2 S DR(2,58.11)="1;10;3;5//^S X=$S(PSGWD'=0:$P(^DIC(42,PSGWD,0),""^"",1),1:"""");30;I X="""" S Y=16;31//O;I X'=""O"" S Y=16;33//ON-DEMAND REQ.;16///"_PSGWODT
 S DR(3,58.13)=".01"
 S DR(3,58.28)="S OLD=$P(^PSI(58.1,AOU,1,DA(1),5,DA,0),""^"",2);1;S QD=X-OLD;2////"_DUZ
 Q
 ;
SCR ;This subroutine will ONLY be called from DIC("S")
 S DRGDA=+^(0)
 I '$D(^PSDRUG(DRGDA,"I")) D SCR2 Q  ;Drug is NOT inactive in file #50 - OK
 I +^PSDRUG(DRGDA,"I")>DT D SCR2 Q  ;Drug is inactive in file #50 IN FUTURE - OK
 I '$D(^PSI(58.1,AOU,1,+Y,"I")) D SCR2 Q  ;Drug is inactive in file #50 but NOT file #58.1 - OK
 I +$O(^PSI(58.1,AOU,1,+Y,"I",0))>DT D SCR2 Q  ;Drug is inactive in file #50 and inactive in file #58.1 IN FUTURE - OK
 Q
SCR2 ;Check for NON-PHARMACY ITEMS
 I $S('$D(^PSDRUG(DRGDA,2)):1,$P(^(2),"^",3)="":1,$P(^(2),"^",3)["O":1,$P(^(2),"^",3)["U":1,$P(^(2),"^",3)["I":1,1:$P(^(2),"^",3)["N") Q

PSGWSTKI
PSGWSTKI ;BHAM ISC/CML-Stock Item Enter/Edit ; 05/29/90 15:46 [ 01/03/2002  10:37 AM ]
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 ;;2.2;;**1** Original VA Patch 28
AOU ; SELECT AOU
 K DA,DIC F QQ=0:0 S DIC="^PSI(58.1,",DIC(0)="QEAMZ" W ! D ^DIC K DIC Q:Y'>0  S AOU=+Y S:'$D(^PSI(58.1,AOU,1,0)) ^(0)="^58.11IP^^" D ITEM
QUIT K %,AOU,C,D0,D1,DI,DA,DQ,DR,I,ITEM,QQ,X,Y,CHK,DRGDA Q
ITEM ; SELECT ITEM
 F QQ=0:0 K DA S CHK=1,DA(1)=AOU,DIC="^PSI(58.1,"_AOU_",1,",DIC(0)="QEAMOLZ" D ^DIC K DIC Q:Y'>0  S ITEM=+Y D CHK I CHK S DA(1)=AOU,DA=ITEM,DIE="^PSI(58.1,"_AOU_",1,",DR="1;13;14;3;10;5",DR(2,58.13)=".01" D ^DIE K DIE W !
 Q
CHK ; CHECK FOR CURRENT INACTIVATION DATE
 I '$D(^PSI(58.1,AOU,1,ITEM,"I")) D CHK2 Q
 D CHK2 Q:'CHK
 W *7,!!?5,"This Item is currently defined for this AOU with an INACTIVATION DATE.",!!?5,"If you want to add this Item as a new standard Stock Item for this AOU",!?5,"you must delete the INACTIVATION DATE.",!
 S DA(1)=AOU,DA=ITEM,DIE="^PSI(58.1,"_AOU_",1,",DR=30 D ^DIE K DIE S CHK=$S($D(Y):0,$D(^PSI(58.1,AOU,1,ITEM,"I")):0,1:1) W !
 Q
CHK2 ; CHECK FOR NON-PHARMACY ITEMS
 S DRGDA=+^PSI(58.1,AOU,1,ITEM,0)
 S CHK=$S('$D(^PSDRUG(DRGDA,2)):1,$P(^(2),"^",3)="":1,$P(^(2),"^",3)["O":1,$P(^(2),"^",3)["U":1,$P(^(2),"^",3)["I":1,1:$P(^(2),"^",3)["N") Q:CHK
 I '$D(^PSI(58.1,AOU,1,ITEM,"I")) S DA(1)=AOU,DA=ITEM,DIE="^PSI(58.1,"_AOU_",1,",DR=30_"///"_DT D ^DIE K DIE
 W *7,!!?5,"This item is currently defined for this AOU but appears to be a",!?5,"non-pharmacy drug.  It has been inactivated as of " S Y=$O(^PSI(58.1,AOU,1,ITEM,"I",0)) X ^DD("DD") W Y,!
 Q

PSGWUTL
PSGWUTL ;BHAM ISC/CML-Utility routine for FileMan functions ; 10/02/89 13:16 [ 01/03/2002  10:38 AM ]
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 ;;2.2;;**1** Original VA Patch 28
OND ;Check quantities for On-Demands/Returns
 Q:'$D(^PSI(58.1,DA(2),1,DA(1),0))  Q:'$P(^(0),"^",2)  I X'>(2*$P(^(0),"^",2)) Q
 W *7,!!,"This quantity seems too high!  The normal Stock Level for this item is ",$P(^PSI(58.1,DA(2),1,DA(1),0),"^",2)
ASK W !?5,"Are you sure of this amount " S %=2 D YN^DICN I %=1 K %,%Y Q
 I %=0!(%=-1) W "    Enter 'YES' or 'NO'" G ASK
 K X,%,%Y Q
QUIT K %,%Y,ADT,AOU,LP,II,ITM Q
 ;SUBROUTINES FOR AMIS XREFS
QD ;SET "AMIS" XREF FOR QTY DISPENSED
 Q:$D(PSGWV)  I X'=0,$P(^PSI(58.1,DA(2),0),"^",3)'=1,$P(^(1,DA(1),1,DA,0),"^",4)'=1 Q:'$D(^PSI(58.19,DA))  S ADT=$P(^(DA,0),"^"),AOU=DA(2),ITM=$P(^PSI(58.1,DA(2),1,DA(1),0),"^"),^PSI(58.5,"AMIS",$H,ADT,"A",AOU,ITM,X)=""
 G QUIT
KQD ;KILL "AMIS" XREF FOR QTY DISPENSED
 Q:$D(PSGWV)  Q:'$D(^PSI(58.19,DA))  S ADT=$P(^(DA,0),"^"),AOU=DA(2),ITM=$P(^PSI(58.1,AOU,1,DA(1),0),"^"),LP="" F II=0:0 S LP=$O(^PSI(58.5,"AMIS",LP)) Q:'LP  I $D(^PSI(58.5,"AMIS",LP,ADT,"A",AOU,ITM)) K ^(ITM)
 G QUIT
OD ;SET "AMIS" XREF FOR ON-DEMAND REQUEST
 Q:$D(PSGWV)  I X'=0,$P(^PSI(58.1,DA(2),0),"^",3)'=1,$P(^(1,DA(1),5,DA,0),"^",4)'=1 S ADT=$P(^(0),"^"),AOU=DA(2),ITM=$P(^PSI(58.1,DA(2),1,DA(1),0),"^"),^PSI(58.5,"AMIS",$H,ADT,"W",AOU,ITM,X)=""
 G QUIT
KOD ;KILL "AMIS" XREF FOR ON-DEMAND REQUEST
 Q:$D(PSGWV)  S ADT=$P(^PSI(58.1,DA(2),1,DA(1),5,DA,0),"^"),AOU=DA(2),ITM=$P(^PSI(58.1,AOU,1,DA(1),0),"^"),LP="" F II=0:0 S LP=$O(^PSI(58.5,"AMIS",LP)) Q:'LP  I $D(^PSI(58.5,"AMIS",LP,ADT,"W",AOU,ITM)) K ^(ITM)
 G QUIT
RET ;SET "AMIS" XREF FOR RETURNS
 Q:$D(PSGWV)  I X'=0,$P(^PSI(58.1,DA(2),0),"^",3)'=1,$P(^(1,DA(1),3,DA,0),"^",4)'=1 S ADT=DA,AOU=DA(2),ITM=$P(^PSI(58.1,DA(2),1,DA(1),0),"^"),^PSI(58.5,"AMIS",$H,ADT,"R",AOU,ITM,X)=""
 G QUIT
KRET ;KILL "AMIS" XREF FOR RETURNS
 Q:$D(PSGWV)  S ADT=DA,AOU=DA(2),ITM=$P(^PSI(58.1,AOU,1,DA(1),0),"^"),LP="" F II=0:0 S LP=$O(^PSI(58.5,"AMIS",LP)) Q:'LP  I $D(^PSI(58.5,"AMIS",LP,ADT,"R",AOU,ITM)) K ^(ITM)
 G QUIT
QDERR ;SET "AMISERR" XREF ON QTY DISPENSED
 Q:$D(PSGWV)  I $D(^PSI(58.1,DA(2),"SITE")),^("SITE")]"" Q
 I X'=0,$P(^PSI(58.1,DA(2),0),"^",3)'=1,$P(^(1,DA(1),1,DA,0),"^",4)'=1 Q:'$D(^PSI(58.19,DA))  S ADT=$P(^(DA,0),"^"),AOU=DA(2),ITM=$P(^PSI(58.1,DA(2),1,DA(1),0),"^"),^PSI(58.5,"AMISERR",AOU,$H,ADT,"A",ITM,X)=""
 G QUIT
KQDERR ;KILL "AMISERR" XREF ON QTY DISPENSED
 Q:$D(PSGWV)  Q:'$D(^PSI(58.19,DA))  S ADT=$P(^(DA,0),"^"),AOU=DA(2),ITM=$P(^PSI(58.1,DA(2),1,DA(1),0),"^"),LP=""
 F II=0:0 S LP=$O(^PSI(58.5,"AMISERR",AOU,LP)) Q:'LP  I $D(^PSI(58.5,"AMISERR",AOU,LP,ADT,"A",ITM)) K ^(ITM)
 G QUIT
ODERR ;SET "AMISERR" XREF ON ON-DEMANDS
 Q:$D(PSGWV)  I $D(^PSI(58.1,DA(2),"SITE")),^("SITE")]"" Q
 I X'=0,$P(^PSI(58.1,DA(2),0),"^",3)'=1,$P(^(1,DA(1),5,DA,0),"^",4)'=1 S ADT=$P(^(0),"^"),AOU=DA(2),ITM=$P(^PSI(58.1,DA(2),1,DA(1),0),"^"),^PSI(58.5,"AMISERR",AOU,$H,ADT,"W",ITM,X)=""
 G QUIT
KODERR ;KILL "AMISERR" XREF ON ON-DEMANDS
 Q:$D(PSGWV)  S ADT=$P(^PSI(58.1,DA(2),1,DA(1),5,DA,0),"^"),AOU=DA(2),ITM=$P(^PSI(58.1,DA(2),1,DA(1),0),"^"),LP=""
 F II=0:0 S LP=$O(^PSI(58.5,"AMISERR",AOU,LP)) Q:'LP  I $D(^PSI(58.5,"AMISERR",AOU,LP,ADT,"A",ITM)) K ^(ITM)
 G QUIT
RETERR ;SET "AMISERR" XREF ON RETURNS
 Q:$D(PSGWV)  I $D(^PSI(58.1,DA(2),"SITE")),^("SITE")]"" Q
 I X'=0,$P(^PSI(58.1,DA(2),0),"^",3)'=1,$P(^(1,DA(1),3,DA,0),"^",4)'=1 S ADT=DA,AOU=DA(2),ITM=$P(^PSI(58.1,DA(2),1,DA(1),0),"^"),^PSI(58.5,"AMISERR",AOU,$H,ADT,"R",ITM,X)=""
 G QUIT
KRETERR ;KILL "AMISERR" XREF ON RETURNS
 Q:$D(PSGWV)  S ADT=DA,AOU=DA(2),ITM=$P(^PSI(58.1,DA(2),1,DA(1),0),"^"),LP=""
 F II=0:0 S LP=$O(^PSI(58.5,"AMISERR",AOU,LP)) Q:'LP  I $D(^PSI(58.5,"AMISERR",AOU,LP,ADT,"A",ITM)) K ^(ITM)
 G QUIT
DRGSCRN ;SCREEN DRUG FILE DRUGS FOR AR FOR ^DD(58.11,.01,0) AND ^DD(58.11,.01,12.1)
 I $S('$D(^("I")):1,+^("I")>DT:1,1:0) S APU=$P($G(^(2)),"^",3) I $S(APU="":1,APU["O":1,APU["U":1,APU["I":1,1:APU["N")
 K APU Q

PSIVCHK
PSIVCHK ; B'ham ISC/PR - CHECK ORDER FOR INTEGRITY ;6/4/90  16:23 [ 04/30/1999  11:01 AM ]
 ;;3.2;INPATIENT MEDICATIONS;**2**;04/27/99
 ;Need DFN and ON
SETP S Y=^PS(55,DFN,"IV",ON,0) F X=1:1:23 S P(X)=$P(Y,"^",X)
 W ! S ERR=0 S:P(4)="C" P(4)=P(23) I P(4)="S" S P(4)=$S(P(5):"P",1:"A")
 I P(1)<1!(P(1)'=ON) S ERR=1 W !,"*** Order Number is invalid !!"
 I P(11)]"" S X=P(11) X $P(^DD(51.1,1,0),"^",5,999) I '$D(X) W !,"*** Your administration time(s) are in an invalid format !" S ERR=1
 I '$D(^PS(55,"AIV",+P(3),DFN,ON)) S ERR=1 W !,"*** Stop date/time x-ref is non-existent !"
 I P(15)<0 S ERR=1 W !,"*** Time interval between doses is less than zero !"
 I P(4)="P",(P(15)!("^NOW^STAT^ONCE^"[("^"_$P(P(9)," ")_"^"))),P(11)["-" S:'ERR ERR=2 W !,"*** WARNING -- You have a non-standard schedule ...",!?15,"with an administration time."
 ;beginning Y2K fix
 ;F X=2,3 I P(X)'?1"2"6N1"."1N.N!($L(P(X))>12) S ERR=1 W !,"*** ",$S(X=2:"Start",1:"Stop")," date is in an invalid format or must contain time !"
 N XX F XX=2,3 S X=$$FMTH^XLFDT(P(XX)) I '$P(X,",",2)!($L(P(XX))>12) S ERR=1 W !,"*** ",$S(XX=2:"Start",1:"Stop")," date is in an invalid format or must contain time !" ;IHS/DSD/ENM 04/01/99 ;Y2000
 ;end Y2K fix block
 I P(2)>P(3) S ERR=1 W !,"*** Start date/time CANNOT be greater than the stop date/time"
INF I P(8)="","AH"[P(4) S ERR=1 W !,"*** You have no infusion rate defined !"
 I "AH"[P(4),P(8)'?1N.N1" ml/hr",P(8)'?.E1"@"1N.N S ERR=1 W !,"*** Your infusion rate is in an invalid format !"
 I P(8)="",P(4)="P" S:'ERR ERR=2 W !,"*** WARNING -- You have not specified an infusion rate. "
 I ^DD(55.01,.04,0)'[(P(4)_":")!(P(4)="") S ERR=1 W !,"*** Type of order is invalid !"
 I ^DD(55.01,100,0)'[(P(17)_":")!(P(17)="") S ERR=1 W !,"*** Status of order is invalid !"
AH ;
 I "HA"[P(4),(P(11)]""!(P(9)]"")) W !,*7,"Order type is an admixture, hyperal, or continuous syringe, and you have",!,"a schedule and/or administration times defined!"
 I  F Q=0:0 W !,"Ok to delete these fields" S %=1 D YN^DICN D NULSET Q:%
 K % I P(6)="" S ERR=1 W !,"*** You have not entered a physician!"
 I P(6)]"",'$D(^DIC(16,P(6),0)) S ERR=1 W !,"*** Physician entered does not exist!"
 I P(6)]"",'$S($D(^DIC(6,P(6),"I")):DT<^("I")!'^("I"),1:1) S ERR=1 W !,"*** Physician entered is no longer active."
 I P(9)="",P(4)="P" S ERR=1 W !,"*** No schedule exists for this order!"
 I P(10)<0 S ERR=1 W !,"*** No. of labels last printed is less than zero!"
 I P(11)="",P(4)="P",'P(15),"^NOW^STAT^ONCE^"'[("^"_$P(P(9)," ")_"^") S ERR=1 W !,"*** There are no administration times defined for this order!"
 G ^PSIVCHK1
NULSET ;Delete admin/schedule fields for hyperals and/or admixtures
 I '% W !!?2,"Enter 'YES' to delete the schedule and/or administration times fields from",!,"this order.  Enter 'NO' (or '^') to leave the fields intact.",! Q
 S:%=1 $P(^PS(55,DFN,"IV",ON,0),U,9)="",$P(^(0),U,11)=""
 Q
CKO S P16=0,PSIVEXAM=1,PSIVCT=1 D PSIVCHK S PSIVNOL=1 W ! D ^PSIVLABL K PSIVEXAM Q:'ERR
 I PSIVREA="V",(ERR=1) W !,"This is an incomplete order!",!,"Please complete and then verify the order",! S XED=1 Q
 I ERR=2 F J=0:0 W !!,"Since there is a warning with this order.",!,"do you wish to re-edit this order" S %=1 D YN^DICN Q:%  W !!,"Answer 'YES' to re-edit this order."
 I ERR=2,%=1 K DA,DIE,DR S DR="[PSJIEDT]",DA=DFN,DIE="^PS(55," D ^DIE K DA,DIE,DR G CKO
 I ERR=1,P17'="N" W !,"Please re-edit this order.",! K DA,DIE,DR S DR="[PSJIEDT]",DA=DFN,DIE="^PS(55," D ^DIE K DA,DIE,DR G CKO
 Q

PSJ4I001
PSJ4I001 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 Q:'DIFQ(50)  F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^DIC(50,0,"GL")
 ;;=^PSDRUG(
 ;;^DIC("B","DRUG",50)
 ;;=
 ;;^DIC(50,"%",0)
 ;;=^1.005^1^1
 ;;^DIC(50,"%",1,0)
 ;;=PS
 ;;^DIC(50,"%","B","PS",1)
 ;;=
 ;;^DIC(50,"%D",0)
 ;;=^^9^9^2920518^^^^
 ;;^DIC(50,"%D",1,0)
 ;;=This file holds the information related to each drug that can be used
 ;;^DIC(50,"%D",2,0)
 ;;=to fill a prescription.  It is pointed to from several other files and
 ;;^DIC(50,"%D",3,0)
 ;;=should be handled carefully, usually only by special individuals in the
 ;;^DIC(50,"%D",4,0)
 ;;=pharmacy service.  Entries are not typically deleted, but rather made
 ;;^DIC(50,"%D",5,0)
 ;;=inactive by entering an inactive date.
 ;;^DIC(50,"%D",6,0)
 ;;= 
 ;;^DIC(50,"%D",7,0)
 ;;=This file must be built by Pharmacy Service BEFORE going on-line.  It is
 ;;^DIC(50,"%D",8,0)
 ;;=common to use another centers file and edit it to match your center's
 ;;^DIC(50,"%D",9,0)
 ;;=unique formulary.
 ;;^DD(50,0)
 ;;=FIELD^NL^302^52
 ;;^DD(50,0,"DT")
 ;;=2910815
 ;;^DD(50,0,"ID",2)
 ;;=W ""
 ;;^DD(50,0,"ID",6)
 ;;=W ""
 ;;^DD(50,0,"ID",51)
 ;;=W:$P(^(0),"^",9) "   N/F"
 ;;^DD(50,0,"ID",101)
 ;;=W:$P(^(0),"^",10)]"" "   ",$P(^(0),U,10),*7
 ;;^DD(50,0,"ID",102)
 ;;=W:$D(^(2)) "   ",$P(^(2),U,2)
 ;;^DD(50,0,"IX","AC",50,2)
 ;;=
 ;;^DD(50,0,"IX","AD",50,201)
 ;;=
 ;;^DD(50,0,"IX","AE",50,202)
 ;;=
 ;;^DD(50,0,"IX","AF",50,201.3)
 ;;=
 ;;^DD(50,0,"IX","AFA",50.065,.01)
 ;;=
 ;;^DD(50,0,"IX","AI",50,100)
 ;;=
 ;;^DD(50,0,"IX","AIU",50,63)
 ;;=
 ;;^DD(50,0,"IX","AP",50,64)
 ;;=
 ;;^DD(50,0,"IX","APC",50,64)
 ;;=
 ;;^DD(50,0,"IX","APCC",50,2)
 ;;=
 ;;^DD(50,0,"IX","APN",50,64)
 ;;=
 ;;^DD(50,0,"IX","APN1",50,20)
 ;;=
 ;;^DD(50,0,"IX","APN2",50,22)
 ;;=
 ;;^DD(50,0,"IX","AR",50,100)
 ;;=
 ;;^DD(50,0,"IX","AUDAP",50,.01)
 ;;=
 ;;^DD(50,0,"IX","AV1",50,200)
 ;;=
 ;;^DD(50,0,"IX","AV2",50,201)
 ;;=
 ;;^DD(50,0,"IX","B",50,.01)
 ;;=
 ;;^DD(50,0,"IX","C",50.1,.01)
 ;;=
 ;;^DD(50,0,"IX","IU",50,63)
 ;;=
 ;;^DD(50,0,"IX","IV",50.03,.01)
 ;;=
 ;;^DD(50,0,"IX","IV1",50,204)
 ;;=
 ;;^DD(50,0,"IX","IV2",50,201.1)
 ;;=
 ;;^DD(50,0,"IX","VAC",50,25)
 ;;=
 ;;^DD(50,0,"IX","XATC",50,212.2)
 ;;=
 ;;^DD(50,0,"NM","DRUG")
 ;;=
 ;;^DD(50,0,"PT",2.55,.01)
 ;;=
 ;;^DD(50,0,"PT",50,62.05)
 ;;=
 ;;^DD(50,0,"PT",50.065,.01)
 ;;=
 ;;^DD(50,0,"PT",50.21,1)
 ;;=
 ;;^DD(50,0,"PT",52.6,1)
 ;;=
 ;;^DD(50,0,"PT",52.7,1)
 ;;=
 ;;^DD(50,0,"PT",53.1,24)
 ;;=
 ;;^DD(50,0,"PT",53.11,.01)
 ;;=
 ;;^DD(50,0,"PT",53.21,.01)
 ;;=
 ;;^DD(50,0,"PT",53.2102,.01)
 ;;=
 ;;^DD(50,0,"PT",53.4502,.01)
 ;;=
 ;;^DD(50,0,"PT",55.06,24)
 ;;=
 ;;^DD(50,0,"PT",55.0611,.02)
 ;;=
 ;;^DD(50,0,"PT",55.07,.01)
 ;;=
 ;;^DD(50,0,"PT",57.63,.01)
 ;;=
 ;;^DD(50,0,"PT",58.11,.01)
 ;;=
 ;;^DD(50,0,"PT",58.3,.01)
 ;;=
 ;;^DD(50,0,"PT",58.52,.01)
 ;;=
 ;;^DD(50,0,"PT",59,.52)
 ;;=
 ;;^DD(50,0,"PT",100.1,.01)
 ;;=
 ;;^DD(50,.01,0)
 ;;=GENERIC NAME^RF^^0;1^K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>40!($L(X)<1)!'(X'?1P.E)!(X'?.ANP) X
 ;;^DD(50,.01,1,0)
 ;;=^.1^^-1
 ;;^DD(50,.01,1,1,0)
 ;;=50^B
 ;;^DD(50,.01,1,1,1)
 ;;=S ^PSDRUG("B",$E(X,1,40),DA)=""
 ;;^DD(50,.01,1,1,2)
 ;;=K ^PSDRUG("B",$E(X,1,40),DA)
 ;;^DD(50,.01,1,3,0)
 ;;=50^AUDAP^MUMPS
 ;;^DD(50,.01,1,3,1)
 ;;=I '$D(PSGINITF) S ^PSDRUG("AUDAP")=$S($D(^PS(59.7,1,20)):$P(^(20),"^"),1:"")
 ;;^DD(50,.01,1,3,2)
 ;;=Q
 ;;^DD(50,.01,1,3,3)
 ;;=Used by the Inpatient Medications init process.
 ;;^DD(50,.01,1,3,"%D",0)
 ;;=^^5^5^2920518^^
 ;;^DD(50,.01,1,3,"%D",1,0)
 ;;=  This cross reference is used by the Inpatient Medications post-init

PSJ4I002
PSJ4I002 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 Q:'DIFQ(50)  F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^DD(50,.01,1,3,"%D",2,0)
 ;;=process.  If this cross reference is not found when the inits are run, all
 ;;^DD(50,.01,1,3,"%D",3,0)
 ;;=of the entries in this file are marked for use by the Unit Dose Medications
 ;;^DD(50,.01,1,3,"%D",4,0)
 ;;=package by updating the APPLICATION PACKAGES USE field for each entry.
 ;;^DD(50,.01,1,3,"%D",5,0)
 ;;=(Routine used is PSGPOST).
 ;;^DD(50,.01,3)
 ;;=Answer must be 1-40 characters in length.
 ;;^DD(50,.01,20,0)
 ;;=^.3LA^2^1
 ;;^DD(50,.01,20,1,0)
 ;;=PH
 ;;^DD(50,.01,20,2,0)
 ;;=PS
 ;;^DD(50,.01,21,0)
 ;;=^^1^1^2920518^^
 ;;^DD(50,.01,21,1,0)
 ;;=This is the generic name of the drug.
 ;;^DD(50,.01,22)
 ;;=
 ;;^DD(50,.01,"DEL",.01,0)
 ;;=I 1 W !?10,"DELETIONS ARE NOT ALLOWED"
 ;;^DD(50,.01,"DT")
 ;;=2911126
 ;;^DD(50,2,0)
 ;;=VA CLASSIFICATION^FX^^0;2^K:X[""""!($A(X)=45) X I $D(X) K:$L(X)<1!($L(X)>5) X I $D(X) K:$S($D(^PSDRUG(DA,"ND")):+^("ND"),1:0) X W:'$D(X) "   Uneditable" Q:'$D(X)  S DIC="^PS(50.605,",DIC(0)="EQM" D ^DIC K:Y<0 X S:Y>0 X=$P(Y,"^",2)
 ;;^DD(50,2,1,0)
 ;;=^.1
 ;;^DD(50,2,1,1,0)
 ;;=50^AC^MUMPS
 ;;^DD(50,2,1,1,1)
 ;;=S X=$O(^PS(50.605,"B",X,0)),$P(^PSDRUG(DA,"ND"),"^",6)=X
 ;;^DD(50,2,1,1,2)
 ;;=I $D(^PSDRUG(DA,"ND")) K:$P(^PSDRUG(DA,"ND"),"^",2)="" ^PSDRUG(DA,"ND")
 ;;^DD(50,2,1,1,3)
 ;;=SPECIAL CROSS-REFERENCE - DO NOT DELETE.
 ;;^DD(50,2,1,1,"%D",0)
 ;;=^^1^1^2911126^
 ;;^DD(50,2,1,1,"%D",1,0)
 ;;=  This is used to automatically update the NATIONAL DRUG CLASS field (25).
 ;;^DD(50,2,1,1,"DT")
 ;;=2910823
 ;;^DD(50,2,1,2,0)
 ;;=50^APCC^MUMPS
 ;;^DD(50,2,1,2,1)
 ;;=S X(1)=$P($G(^PSDRUG(DA,2)),"^",6) S:X(1) ^PSDRUG("APC",X(1),X,DA)=""
 ;;^DD(50,2,1,2,2)
 ;;=S X(1)=$P($G(^PSDRUG(DA,2)),"^",6) K:X(1) ^PSDRUG("APC",X(1),X,DA)
 ;;^DD(50,2,1,2,3)
 ;;=Needed as a primary drug-VA class link.
 ;;^DD(50,2,1,2,"%D",0)
 ;;=^^2^2^2911126^
 ;;^DD(50,2,1,2,"%D",1,0)
 ;;=  This is used as a link between the Primary Drug file and VA
 ;;^DD(50,2,1,2,"%D",2,0)
 ;;=classification.
 ;;^DD(50,2,1,2,"DT")
 ;;=2910801
 ;;^DD(50,2,3)
 ;;=Enter the VA Classification.
 ;;^DD(50,2,4)
 ;;=S DIC="^PS(50.605,",DIC(0)="EQM" D ^DIC
 ;;^DD(50,2,5,1,0)
 ;;=50^25^2
 ;;^DD(50,2,20,0)
 ;;=^.3LA^2^1
 ;;^DD(50,2,20,1,0)
 ;;=PH
 ;;^DD(50,2,20,2,0)
 ;;=PS
 ;;^DD(50,2,21,0)
 ;;=^^1^1^2901024^
 ;;^DD(50,2,21,1,0)
 ;;=  This is the VA classification for this drug.
 ;;^DD(50,2,"DEL",2,0)
 ;;=I $D(^PSDRUG(DA,"ND")),+^("ND") W !,"Deletions are not allowed"
 ;;^DD(50,2,"DT")
 ;;=2910823
 ;;^DD(50,20,0)
 ;;=NATIONAL DRUG FILE ENTRY^P50.6^PSNDF(^ND;1^Q
 ;;^DD(50,20,1,0)
 ;;=^.1
 ;;^DD(50,20,1,1,0)
 ;;=50^APN1^MUMPS
 ;;^DD(50,20,1,1,1)
 ;;=S X(1)=$P($G(^PSDRUG(DA,2)),"^",6) I X(1) S X(2)=$P($G(^("ND")),"^",3) I X(2)]"" S ^PSDRUG("APN",X(1),X_"A"_X(2),DA)=""
 ;;^DD(50,20,1,1,2)
 ;;=S X(1)=$P($G(^PSDRUG(DA,2)),"^",6) I X(1) S X(2)=$P($G(^("ND")),"^",3) I X(2)]"" K ^PSDRUG("APN",X(1),X_"A"_X(2),DA)
 ;;^DD(50,20,1,1,3)
 ;;=Needed by Inpatient Medications.
 ;;^DD(50,20,1,1,"%D",0)
 ;;=^^2^2^2910807^
 ;;^DD(50,20,1,1,"%D",1,0)
 ;;=  Used by Inpatient Medications as a gateway from Primary Drug to National
 ;;^DD(50,20,1,1,"%D",2,0)
 ;;=Drug File.
 ;;^DD(50,20,1,1,"DT")
 ;;=2910807
 ;;^DD(50,20,3)
 ;;=Enter the corresponding National Drug File entry.
 ;;^DD(50,20,8.5)
 ;;=^
 ;;^DD(50,20,9)
 ;;=^
 ;;^DD(50,20,20,0)
 ;;=^.3LA^1^1
 ;;^DD(50,20,20,1,0)
 ;;=PSN
 ;;^DD(50,20,21,0)
 ;;=^^1^1^2901029^^

PSJ4I003
PSJ4I003 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 Q:'DIFQ(50)  F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^DD(50,20,21,1,0)
 ;;=This is the pointer to the National Drug file (^PSNDF).
 ;;^DD(50,20,"DT")
 ;;=2910807
 ;;^DD(50,22,0)
 ;;=PSNDF VA PRODUCT NAME ENTRY^NJ3,0O^^ND;3^K:+X'=X!(X>999)!(X<1)!(X?.E1"."1N.N) X
 ;;^DD(50,22,1,0)
 ;;=^.1
 ;;^DD(50,22,1,1,0)
 ;;=50^APN2^MUMPS
 ;;^DD(50,22,1,1,1)
 ;;=S X(1)=$P($G(^PSDRUG(DA,2)),"^",6) I X(1) S X(2)=$P($G(^("ND")),"^") I X(2)]"" S ^PSDRUG("APN",X(1),X(2)_"A"_X,DA)=""
 ;;^DD(50,22,1,1,2)
 ;;=S X(1)=$P($G(^PSDRUG(DA,2)),"^",6) I X(1) S X(2)=$P($G(^("ND")),"^") I X(2)]"" K ^PSDRUG("APN",X(1),X(2)_"A"_X,DA)
 ;;^DD(50,22,1,1,3)
 ;;=Needed by Inpatient Medications
 ;;^DD(50,22,1,1,"%D",0)
 ;;=^^2^2^2910807^
 ;;^DD(50,22,1,1,"%D",1,0)
 ;;=  Used by Inpatient Medications as a gateway from Primary Drug to National
 ;;^DD(50,22,1,1,"%D",2,0)
 ;;=Drug File.
 ;;^DD(50,22,1,1,"DT")
 ;;=2910807
 ;;^DD(50,22,2)
 ;;=S Y(0)=Y D FORM^PSNOUT
 ;;^DD(50,22,2.1)
 ;;=D FORM^PSNOUT
 ;;^DD(50,22,3)
 ;;=Type a whole Number between 1 and 999, 0 Decimal digits.
 ;;^DD(50,22,8.5)
 ;;=^
 ;;^DD(50,22,9)
 ;;=^
 ;;^DD(50,22,20,0)
 ;;=^.3LA^1^1
 ;;^DD(50,22,20,1,0)
 ;;=PSN
 ;;^DD(50,22,21,0)
 ;;=^^1^1^2901026^
 ;;^DD(50,22,21,1,0)
 ;;=This is the index of the VA Product Name in the National Drug file.
 ;;^DD(50,22,"DT")
 ;;=2910807
 ;;^DD(50,51,0)
 ;;=NON-FORMULARY^SX^1:N/F;^0;9^I X,$O(^PSDRUG("AFA",DA,0)) W !!,"This drug is designated as a formulary alternative for:" F X=0:0 S X=$O(^PSDRUG("AFA",DA,X)) K:'X X W:'$D(X) ! Q:'$D(X)  W !?3,$J(X,6)," - ",$P($G(^PSDRUG(X,0)),"^")
 ;;^DD(50,51,3)
 ;;=Enter a '1' if this is not to appear on the formulary list.
 ;;^DD(50,51,20,0)
 ;;=^.3LA^1^1
 ;;^DD(50,51,20,1,0)
 ;;=PS
 ;;^DD(50,51,21,0)
 ;;=^^1^1^2910305^^
 ;;^DD(50,51,21,1,0)
 ;;=  This is used to designate the drug as non-formulary.
 ;;^DD(50,51,"DT")
 ;;=2910728
 ;;^DD(50,64,0)
 ;;=PRIMARY DRUG^RP50.3'^PS(50.3,^2;6^Q
 ;;^DD(50,64,1,0)
 ;;=^.1
 ;;^DD(50,64,1,1,0)
 ;;=50^AP
 ;;^DD(50,64,1,1,1)
 ;;=S ^PSDRUG("AP",X,DA)=""
 ;;^DD(50,64,1,1,2)
 ;;=K ^PSDRUG("AP",X,DA)
 ;;^DD(50,64,1,1,3)
 ;;=Needed by Unit Dose Medications order entry.
 ;;^DD(50,64,1,1,"DT")
 ;;=2910830
 ;;^DD(50,64,1,2,0)
 ;;=50^APC^MUMPS
 ;;^DD(50,64,1,2,1)
 ;;=S X(1)=$P($G(^PSDRUG(DA,0)),"^",2) S:X(1)]"" ^PSDRUG("APC",X,X(1),DA)=""
 ;;^DD(50,64,1,2,2)
 ;;=S X(1)=$P($G(^PSDRUG(DA,0)),"^",2) K:X(1)]"" ^PSDRUG("APC",X,X(1),DA)
 ;;^DD(50,64,1,2,3)
 ;;=This is needed by Unit Dose Medications to do class checking.
 ;;^DD(50,64,1,2,"%D",0)
 ;;=^^2^2^2910806^^
 ;;^DD(50,64,1,2,"%D",1,0)
 ;;=  This allows the Unit Dose Medications package to do class checking for
 ;;^DD(50,64,1,2,"%D",2,0)
 ;;=drugs designated as primary drugs.
 ;;^DD(50,64,1,2,"DT")
 ;;=2910806
 ;;^DD(50,64,1,3,0)
 ;;=50^APN^MUMPS
 ;;^DD(50,64,1,3,1)
 ;;=S X(1)=$G(^PSDRUG(DA,"ND")) I $P(X(1),"^")]"",$P(X(1),"^",3)]"" S ^PSDRUG("APN",X,$P(X(1),"^")_"A"_$P(X(1),"^",3),DA)=""
 ;;^DD(50,64,1,3,2)
 ;;=S X(1)=$G(^PSDRUG(DA,"ND")) I $P(X(1),"^")]"",$P(X(1),"^",3)]"" K ^PSDRUG("APN",X,$P(X(1),"^")_"A"_$P(X(1),"^",3),DA)
 ;;^DD(50,64,1,3,3)
 ;;=Needed by Inpatient Medications as a gateway from Primary to National Drug File.
 ;;^DD(50,64,1,3,"%D",0)
 ;;=^^2^2^2910806^
 ;;^DD(50,64,1,3,"%D",1,0)
 ;;=  This is used by the Inpatient Medications package as a gateway from
 ;;^DD(50,64,1,3,"%D",2,0)
 ;;=Primary Drug to the National Drug File.
 ;;^DD(50,64,1,3,"DT")
 ;;=2910806

PSJ4I004
PSJ4I004 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 Q:'DIFQ(50)  F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^DD(50,64,1,4,0)
 ;;=^^TRIGGER^52.6^16
 ;;^DD(50,64,1,4,1)
 ;;=K DIV S PSJ=X,PSJ1=DA,PSJ2=$O(^DD(52.6,16,1,0)) X ^DD(50,64,1,4,1.1) K PSJ,PSJ1,PSJ2,PSJ3
 ;;^DD(50,64,1,4,1.1)
 ;;=F PSJ3=0:0 S PSJ3=$O(^PS(52.6,"AC",PSJ1,PSJ3)) Q:'PSJ3  I $D(^PS(52.6,PSJ3,0)) S DIU=$P(^(0),"^",12) I DIU'=PSJ S $P(^(0),"^",12)=PSJ I PSJ2 S DIV=PSJ,(D0,DIV(0))=PSJ3,DIH=52.6,DIG=16 D ^DICR
 ;;^DD(50,64,1,4,2)
 ;;=K DIV S PSJ=X,PSJ1=DA,PSJ2=$O(^DD(52.6,16,1,0)) X ^DD(50,64,1,4,2.1) K PSJ,PSJ1,PSJ2,PSJ3
 ;;^DD(50,64,1,4,2.1)
 ;;=F PSJ3=0:0 S PSJ3=$O(^PS(52.6,"AC",PSJ1,PSJ3)) Q:'PSJ3  I $D(^PS(52.6,PSJ3,0)) S DIU=$P(^(0),"^",12) I DIU]"" S $P(^(0),"^",12)="" I PSJ2 S DIV="",(D0,DIV(0))=PSJ3,DIH=52.6,DIG=16 D ^DICR
 ;;^DD(50,64,1,4,3)
 ;;=Needed to update the PRIMARY DRUG field in the IV ADDITIVES file.
 ;;^DD(50,64,1,4,"%D",0)
 ;;=^^2^2^2911008^
 ;;^DD(50,64,1,4,"%D",1,0)
 ;;=  This trigger is needed to update the PRIMARY DRUG field in the IV 
 ;;^DD(50,64,1,4,"%D",2,0)
 ;;=ADDITIVES file for all additives that point to this GENERIC DRUG.
 ;;^DD(50,64,1,4,"CREATE VALUE")
 ;;=X
 ;;^DD(50,64,1,4,"DELETE VALUE")
 ;;=@
 ;;^DD(50,64,1,4,"DT")
 ;;=2911008
 ;;^DD(50,64,1,4,"FIELD")
 ;;=GENERIC NAME:IV ADDITIVES:PRIMARY DRUG
 ;;^DD(50,64,1,5,0)
 ;;=^^TRIGGER^52.7^16
 ;;^DD(50,64,1,5,1)
 ;;=K DIV S PSJ=X,PSJ1=DA,PSJ2=$O(^DD(52.7,16,1,0)) X ^DD(50,64,1,5,1.1) K PSJ,PSJ1,PSJ2,PSJ3
 ;;^DD(50,64,1,5,1.1)
 ;;=F PSJ3=0:0 S PSJ3=$O(^PS(52.7,"AC",PSJ1,PSJ3)) Q:'PSJ3  I $D(^PS(52.7,PSJ3,0)) S DIU=$P(^(0),"^",12) I DIU'=PSJ S $P(^(0),"^",12)=PSJ I PSJ2 S DIV=PSJ,(D0,DIV(0))=PSJ3,DIH=52.7,DIG=16 D ^DICR
 ;;^DD(50,64,1,5,2)
 ;;=K DIV S PSJ=X,PSJ1=DA,PSJ2=$O(^DD(52.7,16,1,0)) X ^DD(50,64,1,5,2.1) K PSJ,PSJ1,PSJ2,PSJ3
 ;;^DD(50,64,1,5,2.1)
 ;;=F PSJ3=0:0 S PSJ3=$O(^PS(52.7,"AC",PSJ1,PSJ3)) Q:'PSJ3  I $D(^PS(52.7,PSJ3,0)) S DIU=$P(^(0),"^",12) I DIU]"" S $P(^(0),"^",12)="" I PSJ2 S DIV="",(D0,DIV(0))=PSJ3,DIH=52.7,DIG=16 D ^DICR
 ;;^DD(50,64,1,5,3)
 ;;=Needed to update the PRIMARY DRUG field in the IV SOLUTIONS file.
 ;;^DD(50,64,1,5,"%D",0)
 ;;=^^2^2^2911008^
 ;;^DD(50,64,1,5,"%D",1,0)
 ;;=  This trigger is needed to update the PRIMARY DRUG field in the IV 
 ;;^DD(50,64,1,5,"%D",2,0)
 ;;=SOLUTIONS file for all additives that point to this GENERIC DRUG.
 ;;^DD(50,64,1,5,"CREATE VALUE")
 ;;=X
 ;;^DD(50,64,1,5,"DELETE VALUE")
 ;;=@
 ;;^DD(50,64,1,5,"DT")
 ;;=2911008
 ;;^DD(50,64,1,5,"FIELD")
 ;;=GENERIC NAME:IV SOLUTIONS:PRIMARY DRUG
 ;;^DD(50,64,3)
 ;;=Enter a primary drug for this drug.
 ;;^DD(50,64,20,0)
 ;;=^.3LA^1^1
 ;;^DD(50,64,20,1,0)
 ;;=PS
 ;;^DD(50,64,21,0)
 ;;=^^2^2^2911220^
 ;;^DD(50,64,21,1,0)
 ;;=  This is the corresponding Primary Drug for this dispense drug.  A primary
 ;;^DD(50,64,21,2,0)
 ;;=drug does not have a dosage associated with it.
 ;;^DD(50,64,23,0)
 ;;=^^4^4^2911220^
 ;;^DD(50,64,23,1,0)
 ;;=  This is the corresponding primary drug for this dispense drug.  The
 ;;^DD(50,64,23,2,0)
 ;;=primary drug will show on the profiles and other reports.  (This dispense
 ;;^DD(50,64,23,3,0)
 ;;=drug shows on the expanded view of the order.)  This is also used to find
 ;;^DD(50,64,23,4,0)
 ;;=the primary drug of an order when a dispense drug is selected.
 ;;^DD(50,64,"DT")
 ;;=2911008
 ;;^DD(50,65,0)
 ;;=FORMULARY ALTERNATIVE^50.065P^^65;0
 ;;^DD(50,65,3)
 ;;=Enter a formulary drug that may be used as an alternative to this non-formulary drug.

PSJ4I005
PSJ4I005 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 Q:'DIFQ(50)  F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^DD(50,65,20,0)
 ;;=^.3LA^1^1
 ;;^DD(50,65,20,1,0)
 ;;=PS
 ;;^DD(50,65,21,0)
 ;;=^^3^3^2910728^^
 ;;^DD(50,65,21,1,0)
 ;;=  This is a formulary alternative to this non-formulary drug.  Any formulary
 ;;^DD(50,65,21,2,0)
 ;;=alternatives are shown to non-pharmacists whenever they attempt to order a
 ;;^DD(50,65,21,3,0)
 ;;=non-formulary drug.
 ;;^DD(50.065,0)
 ;;=FORMULARY ALTERNATIVE SUB-FIELD^^.01^1
 ;;^DD(50.065,0,"DT")
 ;;=2910728
 ;;^DD(50.065,0,"IX","B",50.065,.01)
 ;;=
 ;;^DD(50.065,0,"NM","FORMULARY ALTERNATIVE")
 ;;=
 ;;^DD(50.065,0,"UP")
 ;;=50
 ;;^DD(50.065,.01,0)
 ;;=FORMULARY ALTERNATIVE^M*P50'^PSDRUG(^0;1^S DIC("S")="I '$P(^(0),""^"",9) S X(1)=$G(^(""I"")) I $S('X(1):1,1:X(1)>DT)" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X
 ;;^DD(50.065,.01,1,0)
 ;;=^.1
 ;;^DD(50.065,.01,1,1,0)
 ;;=50.065^B
 ;;^DD(50.065,.01,1,1,1)
 ;;=S ^PSDRUG(DA(1),65,"B",$E(X,1,30),DA)=""
 ;;^DD(50.065,.01,1,1,2)
 ;;=K ^PSDRUG(DA(1),65,"B",$E(X,1,30),DA)
 ;;^DD(50.065,.01,1,2,0)
 ;;=50^AFA^MUMPS
 ;;^DD(50.065,.01,1,2,1)
 ;;=S ^PSDRUG("AFA",X,DA(1))=""
 ;;^DD(50.065,.01,1,2,2)
 ;;=K ^PSDRUG("AFA",X,DA(1))
 ;;^DD(50.065,.01,1,2,3)
 ;;=Referenced when editing the NON-FORMULARY field.
 ;;^DD(50.065,.01,1,2,"%D",0)
 ;;=^^2^2^2910728^^
 ;;^DD(50.065,.01,1,2,"%D",1,0)
 ;;=  Used by the NON-FORMULARY field.  A drug cannot be made non-formulary if
 ;;^DD(50.065,.01,1,2,"%D",2,0)
 ;;=it is a formulary alternative for another drug.
 ;;^DD(50.065,.01,1,2,"DT")
 ;;=2910728
 ;;^DD(50.065,.01,3)
 ;;=ENTER A FORMULARY DRUG AS AN ALTERNATIVE TO THIS N0N-FORMULARY DRUG.
 ;;^DD(50.065,.01,4)
 ;;=W:'$D(DA(1)) ! W "  (This non-formulary item is ",$P(^PSDRUG($S($D(DA(1)):DA(1),1:DA),0),"^"),".)"
 ;;^DD(50.065,.01,12)
 ;;=Alternative must be formulary and active.
 ;;^DD(50.065,.01,12.1)
 ;;=S DIC("S")="I '$P(^(0),""^"",9) S X(1)=$G(^(""I"")) I $S('X(1):1,1:X(1)>DT)"
 ;;^DD(50.065,.01,20,0)
 ;;=^.3LA^1^1
 ;;^DD(50.065,.01,20,1,0)
 ;;=PSJ
 ;;^DD(50.065,.01,21,0)
 ;;=^^3^3^2910904^^^
 ;;^DD(50.065,.01,21,1,0)
 ;;=  This is a formulary alternative for this non-formulary drug.  Any
 ;;^DD(50.065,.01,21,2,0)
 ;;=formulary alternatives entered are shown to non-pharmacists whenever
 ;;^DD(50.065,.01,21,3,0)
 ;;=they attempt to order this non-formulary drug.
 ;;^DD(50.065,.01,"DT")
 ;;=2910728

PSJ4I006
PSJ4I006 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 Q:'DIFQ(50.3)  F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^DIC(50.3,0,"GL")
 ;;=^PS(50.3,
 ;;^DIC("B","PRIMARY DRUG",50.3)
 ;;=
 ;;^DIC(50.3,"%D",0)
 ;;=^^3^3^2911220^
 ;;^DIC(50.3,"%D",1,0)
 ;;=  This contains drug names used to order medications for patients.  These
 ;;^DIC(50.3,"%D",2,0)
 ;;=names are used mainly for selection and printing for non-pharmacy personnel,
 ;;^DIC(50.3,"%D",3,0)
 ;;=as the names HAVE NO DOSAGE ASSOCIATED WITH THEM.
 ;;^DD(50.3,0)
 ;;=FIELD^^.03^5
 ;;^DD(50.3,0,"DT")
 ;;=2920319
 ;;^DD(50.3,0,"ID",.03)
 ;;=W "   ",$P(^(0),U,3)
 ;;^DD(50.3,0,"IX","AIU",50.31,.01)
 ;;=
 ;;^DD(50.3,0,"IX","B",50.3,.01)
 ;;=
 ;;^DD(50.3,0,"IX","C",50.32,.01)
 ;;=
 ;;^DD(50.3,0,"NM","PRIMARY DRUG")
 ;;=
 ;;^DD(50.3,0,"PT",50,64)
 ;;=
 ;;^DD(50.3,0,"PT",50.311,.01)
 ;;=
 ;;^DD(50.3,0,"PT",52.6,16)
 ;;=
 ;;^DD(50.3,0,"PT",52.7,16)
 ;;=
 ;;^DD(50.3,0,"PT",53.1,101)
 ;;=
 ;;^DD(50.3,0,"PT",53.21,.01)
 ;;=
 ;;^DD(50.3,0,"PT",55.01,117)
 ;;=
 ;;^DD(50.3,0,"PT",55.06,101)
 ;;=
 ;;^DD(50.3,0,"PT",57.1,3)
 ;;=
 ;;^DD(50.3,.01,0)
 ;;=NAME^XRF^^0;1^K:$S($L(X)>40:1,$L(X)<3:1,X?1P.E:1,X?2"z".E:1,1:$D(^PS(50.3,"B",X))) X
 ;;^DD(50.3,.01,1,0)
 ;;=^.1
 ;;^DD(50.3,.01,1,1,0)
 ;;=50.3^B
 ;;^DD(50.3,.01,1,1,1)
 ;;=S ^PS(50.3,"B",X,DA)=""
 ;;^DD(50.3,.01,1,1,2)
 ;;=K ^PS(50.3,"B",X,DA)
 ;;^DD(50.3,.01,3)
 ;;=Answer must be 3-40 characters in length.
 ;;^DD(50.3,.01,20,0)
 ;;=^.3LA^1^1
 ;;^DD(50.3,.01,20,1,0)
 ;;=PS
 ;;^DD(50.3,.01,21,0)
 ;;=^^3^3^2920511^^
 ;;^DD(50.3,.01,21,1,0)
 ;;=  This is the name of a drug used by this site.  Primary drug is used to
 ;;^DD(50.3,.01,21,2,0)
 ;;=allow order entry to be easier for non-pharmacy personnel and for display.
 ;;^DD(50.3,.01,21,3,0)
 ;;=THIS NAME MUST BE NAME ONLY, WITH NO DOSAGE.
 ;;^DD(50.3,.01,23,0)
 ;;=^^3^3^2920511^^
 ;;^DD(50.3,.01,23,1,0)
 ;;=  This is used in order entry by non-pharmacy personnel, for display
 ;;^DD(50.3,.01,23,2,0)
 ;;=purposes, and by other packages, when it is inappropriate for the dosage of
 ;;^DD(50.3,.01,23,3,0)
 ;;=the order to be part of the drug name.
 ;;^DD(50.3,.01,"DEL",1,0)
 ;;=I 1 W !!,"Primary Drug entries cannot be deleted."
 ;;^DD(50.3,.01,"DT")
 ;;=2910814
 ;;^DD(50.3,.02,0)
 ;;=DEA, SPECIAL HANDLING^FX^^0;2^K:$L(X)>6!($L(X)<1)!(X'?.N.U) X D:$D(X) EDIT^PSJDEA
 ;;^DD(50.3,.02,3)
 ;;=Answer must be 1-6 characters in length.
 ;;^DD(50.3,.02,4)
 ;;=D ^PSJDEA
 ;;^DD(50.3,.02,20,0)
 ;;=^.3LA^1^1
 ;;^DD(50.3,.02,20,1,0)
 ;;=PS
 ;;^DD(50.3,.02,21,0)
 ;;=^^2^2^2911001^
 ;;^DD(50.3,.02,21,1,0)
 ;;=  This is used to designate any special handling that may apply to this
 ;;^DD(50.3,.02,21,2,0)
 ;;=primary drug.
 ;;^DD(50.3,.02,23,0)
 ;;=^^2^2^2911001^
 ;;^DD(50.3,.02,23,1,0)
 ;;=  This is checked by various functions of the Pharmacy/Medications
 ;;^DD(50.3,.02,23,2,0)
 ;;=packages.
 ;;^DD(50.3,.02,"DT")
 ;;=2911001
 ;;^DD(50.3,.03,0)
 ;;=MESSAGE^F^^0;3^K:$L(X)>68!($L(X)<1) X
 ;;^DD(50.3,.03,3)
 ;;=Answer must be 1-68 characters in length.
 ;;^DD(50.3,.03,20,0)
 ;;=^.3LA^1^1
 ;;^DD(50.3,.03,20,1,0)
 ;;=PS
 ;;^DD(50.3,.03,21,0)
 ;;=^^3^3^2920316^
 ;;^DD(50.3,.03,21,1,0)
 ;;=  This is any information that the pharmacy wants to convey to users who
 ;;^DD(50.3,.03,21,2,0)
 ;;=select this drug.  Common messages include restrictions that may have been
 ;;^DD(50.3,.03,21,3,0)
 ;;=placed on the drug.
 ;;^DD(50.3,.03,23,0)
 ;;=^^2^2^2920316^
 ;;^DD(50.3,.03,23,1,0)
 ;;=  This allows the pharmacy to convey any information about the drug to

PSJ4I007
PSJ4I007 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 Q:'DIFQ(50.3)  F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^DD(50.3,.03,23,2,0)
 ;;=users who select the drug.  This is an identifier.
 ;;^DD(50.3,.03,"DT")
 ;;=2920319
 ;;^DD(50.3,1,0)
 ;;=APPLICATION^50.31O^^1;0
 ;;^DD(50.3,1,2)
 ;;=S Y(0)=Y S Y=$O(^PS(50.35,"C",Y,0)) S:Y Y=$P($G(^PS(50.35,Y,0)),"^") S:Y="" Y=Y(0)
 ;;^DD(50.3,1,2.1)
 ;;=S Y=$O(^PS(50.35,"C",Y,0)) S:Y Y=$P($G(^PS(50.35,Y,0)),"^") S:Y="" Y=Y(0)
 ;;^DD(50.3,1,20,0)
 ;;=^.3LA^1^1
 ;;^DD(50.3,1,20,1,0)
 ;;=PS
 ;;^DD(50.3,1,21,0)
 ;;=^^4^4^2911220^
 ;;^DD(50.3,1,21,1,0)
 ;;=  This is the [DHCP] applications that may make use of this primary drug.
 ;;^DD(50.3,1,21,2,0)
 ;;=This can be used by the applications as a screen, and allows the
 ;;^DD(50.3,1,21,3,0)
 ;;=applications to edit information about the drug that is specific to the
 ;;^DD(50.3,1,21,4,0)
 ;;=application.
 ;;^DD(50.3,1,"DT")
 ;;=2910818
 ;;^DD(50.3,2,0)
 ;;=SYNONYM^50.32^^2;0
 ;;^DD(50.3,2,20,0)
 ;;=^.3LA^1^1
 ;;^DD(50.3,2,20,1,0)
 ;;=PS
 ;;^DD(50.3,2,21,0)
 ;;=^^2^2^2920315^
 ;;^DD(50.3,2,21,1,0)
 ;;=  This allows alternate names, such as trade names, to be entered for
 ;;^DD(50.3,2,21,2,0)
 ;;=primary drugs, allowing primary drugs to be selected by the alternate names.
 ;;^DD(50.3,2,23,0)
 ;;=^^3^3^2920315^
 ;;^DD(50.3,2,23,1,0)
 ;;=  This allows users to provide alternate names for the entries in this
 ;;^DD(50.3,2,23,2,0)
 ;;=file.  Users can then select entries from this file by these alternate
 ;;^DD(50.3,2,23,3,0)
 ;;=names through a regular 'C' cross-reference.
 ;;^DD(50.31,0)
 ;;=APPLICATION SUB-FIELD^^1^8
 ;;^DD(50.31,0,"DT")
 ;;=2920224
 ;;^DD(50.31,0,"IX","AFI",50.31,.01)
 ;;=
 ;;^DD(50.31,0,"IX","AFIF",50.31,.02)
 ;;=
 ;;^DD(50.31,0,"IX","AFII",50.31,.03)
 ;;=
 ;;^DD(50.31,0,"IX","B",50.31,.01)
 ;;=
 ;;^DD(50.31,0,"NM","APPLICATION")
 ;;=
 ;;^DD(50.31,0,"UP")
 ;;=50.3
 ;;^DD(50.31,.01,0)
 ;;=APPLICATION^MFXO^^0;1^D ENALU^PSJPRE41
 ;;^DD(50.31,.01,1,0)
 ;;=^.1
 ;;^DD(50.31,.01,1,1,0)
 ;;=50.31^B
 ;;^DD(50.31,.01,1,1,1)
 ;;=S ^PS(50.3,DA(1),1,"B",$E(X,1,30),DA)=""
 ;;^DD(50.31,.01,1,1,2)
 ;;=K ^PS(50.3,DA(1),1,"B",$E(X,1,30),DA)
 ;;^DD(50.31,.01,1,2,0)
 ;;=50.31^AFI^MUMPS
 ;;^DD(50.31,.01,1,2,1)
 ;;=S X(1)=$G(^PS(50.3,DA(1),1,DA,0)),^PS(50.3,DA(1),1,"AFI",X)='$P(X(1),"^",2)_$S($P(X(1),"^",3):"^"_$P(X(1),"^",3),1:"")
 ;;^DD(50.31,.01,1,2,2)
 ;;=K ^PS(50.3,DA(1),1,"AFI",X)
 ;;^DD(50.31,.01,1,2,3)
 ;;=Needed to know if non-formulary or inactive.
 ;;^DD(50.31,.01,1,2,"%D",0)
 ;;=^^1^1^2910819^
 ;;^DD(50.31,.01,1,2,"%D",1,0)
 ;;=  Provides a quicker check for non-formulary and/or inactive.
 ;;^DD(50.31,.01,1,2,"DT")
 ;;=2910819
 ;;^DD(50.31,.01,1,3,0)
 ;;=50.3^AIU^MUMPS
 ;;^DD(50.31,.01,1,3,1)
 ;;=S X(1)=$P($G(^PS(50.3,DA(1),0)),"^") I X(1)]"" S ^PS(50.3,"AIU"_X,X(1),DA(1))=""
 ;;^DD(50.31,.01,1,3,2)
 ;;=S X(1)=$P($G(^PS(50.3,DA(1),0)),"^") I X(1)]"" K ^PS(50.3,"AIU"_X,X(1),DA(1))
 ;;^DD(50.31,.01,1,3,3)
 ;;=Needed to select drugs by application.
 ;;^DD(50.31,.01,1,3,"%D",0)
 ;;=^^2^2^2910819^
 ;;^DD(50.31,.01,1,3,"%D",1,0)
 ;;=  Used to allow the application to easily select only those drugs marked for
 ;;^DD(50.31,.01,1,3,"%D",2,0)
 ;;=the application.
 ;;^DD(50.31,.01,1,3,"DT")
 ;;=2910819
 ;;^DD(50.31,.01,2)
 ;;=S Y(0)=Y S Y=$O(^PS(50.35,"C",Y,0)) S:Y Y=$P($G(^PS(50.35,Y,0)),"^") S:Y="" Y=Y(0)
 ;;^DD(50.31,.01,2.1)
 ;;=S Y=$O(^PS(50.35,"C",Y,0)) S:Y Y=$P($G(^PS(50.35,Y,0)),"^") S:Y="" Y=Y(0)
 ;;^DD(50.31,.01,3)
 ;;=Select an application for which this drug will be dispensed.

PSJ4I008
PSJ4I008 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 Q:'DIFQ(50.3)  F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^DD(50.31,.01,4)
 ;;=D ENAQ^PSJPRE41
 ;;^DD(50.31,.01,21,0)
 ;;=^^2^2^2911126^
 ;;^DD(50.31,.01,21,1,0)
 ;;=  This is an application (computer package) that would be using entries in
 ;;^DD(50.31,.01,21,2,0)
 ;;=this file.
 ;;^DD(50.31,.01,"DT")
 ;;=2910823
 ;;^DD(50.31,.02,0)
 ;;=NON-FORMULARY^S^1:N/F;^0;2^Q
 ;;^DD(50.31,.02,1,0)
 ;;=^.1
 ;;^DD(50.31,.02,1,1,0)
 ;;=50.31^AFIF^MUMPS
 ;;^DD(50.31,.02,1,1,1)
 ;;=S X(1)=$G(^PS(50.3,DA(1),1,DA,0)) I $P(X(1),"^")]"" S $P(^PS(50.3,DA(1),1,"AFI",$P(X(1),"^")),"^")=""
 ;;^DD(50.31,.02,1,1,2)
 ;;=S X(1)=$G(^PS(50.3,DA(1),1,DA,0)) I $P(X(1),"^")]"" S $P(^PS(50.3,DA(1),1,"AFI",$P(X(1),"^")),"^")=1
 ;;^DD(50.31,.02,1,1,3)
 ;;=Needed to know if non-formulary.
 ;;^DD(50.31,.02,1,1,"%D",0)
 ;;=^^1^1^2910819^
 ;;^DD(50.31,.02,1,1,"%D",1,0)
 ;;=  Used to quickly know if non-formulary.
 ;;^DD(50.31,.02,1,1,"DT")
 ;;=2910819
 ;;^DD(50.31,.02,3)
 ;;=Enter a '1' if this is not to appear on the formulary list.
 ;;^DD(50.31,.02,20,0)
 ;;=^.3LA^1^1
 ;;^DD(50.31,.02,20,1,0)
 ;;=PS
 ;;^DD(50.31,.02,21,0)
 ;;=^^1^1^2910818^
 ;;^DD(50.31,.02,21,1,0)
 ;;=  This is used to designate the drug as non-formulary.
 ;;^DD(50.31,.02,"DT")
 ;;=2911030
 ;;^DD(50.31,.03,0)
 ;;=INACTIVE DATE^D^^0;3^S %DT="EX" D ^%DT S X=Y K:Y<1 X
 ;;^DD(50.31,.03,1,0)
 ;;=^.1
 ;;^DD(50.31,.03,1,1,0)
 ;;=50.31^AFII^MUMPS
 ;;^DD(50.31,.03,1,1,1)
 ;;=S X(1)=$G(^PS(50.3,DA(1),1,DA,0)) I $P(X(1),"^")]"" S $P(^PS(50.3,DA(1),1,"AFI",$P(X(1),"^")),"^",2)=X
 ;;^DD(50.31,.03,1,1,2)
 ;;=S X(1)=$G(^PS(50.3,DA(1),1,DA,0)) I $P(X(1),"^")]"" S $P(^PS(50.3,DA(1),1,"AFI",$P(X(1),"^")),"^",2)=""
 ;;^DD(50.31,.03,1,1,3)
 ;;=Needed to know if inactive.
 ;;^DD(50.31,.03,1,1,"%D",0)
 ;;=^^1^1^2910819^
 ;;^DD(50.31,.03,1,1,"%D",1,0)
 ;;=  Used to quickly know if inactive.
 ;;^DD(50.31,.03,1,1,"DT")
 ;;=2910819
 ;;^DD(50.31,.03,3)
 ;;=Enter a date this drug is to be inactive.
 ;;^DD(50.31,.03,20,0)
 ;;=^.3LA^1^1
 ;;^DD(50.31,.03,20,1,0)
 ;;=PS
 ;;^DD(50.31,.03,21,0)
 ;;=^^1^1^2911107^^
 ;;^DD(50.31,.03,21,1,0)
 ;;=  This is the date this drug is inactive.
 ;;^DD(50.31,.03,"DT")
 ;;=2910819
 ;;^DD(50.31,.05,0)
 ;;=DAY (nD) or DOSE (nL) LIMIT^FX^^0;5^K:$S('X:1,X?1.2N1"D":0,1:X'?1.2N1"L") X
 ;;^DD(50.31,.05,.1)
 ;;=
 ;;^DD(50.31,.05,3)
 ;;=Type a whole Number between 0 and 99, 0 Decimal Digits, followed by either a 'D' (for NUMBER OF DAYS) or an 'L' (for DOSE LIMIT).
 ;;^DD(50.31,.05,20,0)
 ;;=^.3LA^1^1
 ;;^DD(50.31,.05,20,1,0)
 ;;=PS
 ;;^DD(50.31,.05,21,0)
 ;;=^^6^6^2910815^^^^
 ;;^DD(50.31,.05,21,1,0)
 ;;=  If found when this drug is ordered, this is used to calculate a DEFAULT
 ;;^DD(50.31,.05,21,2,0)
 ;;=value for the STOP DATE prompt of the order.  If the number entered here is
 ;;^DD(50.31,.05,21,3,0)
 ;;=followed by a "D", that NUMBER OF DAYS will be added to the START DATE to
 ;;^DD(50.31,.05,21,4,0)
 ;;=calculate the STOP DATE.  If the number entered is followed by an "L", the
 ;;^DD(50.31,.05,21,5,0)
 ;;=number is used as the NUMBER OF DOSES to calculate the stop date.
 ;;^DD(50.31,.05,21,6,0)
 ;;=  This is best used for NARCOTICS and ANTIBIOTICS.
 ;;^DD(50.31,.05,"DT")
 ;;=2910815
 ;;^DD(50.31,.06,0)
 ;;=MED ROUTE^*P51.2'^PS(51.2,^0;6^S DIC("S")="I $P(^(0),""^"")'=""ORAL"",$P(^(0),""^"",4)" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X
 ;;^DD(50.31,.06,.1)
 ;;=
 ;;^DD(50.31,.06,3)
 ;;=Enter the most common MED ROUTE associated with this medication.

PSJ4I009
PSJ4I009 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 Q:'DIFQ(50.3)  F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^DD(50.31,.06,12)
 ;;=ONLY MED ROUTES MARKED FOR USE BY ALL PACKAGES ARE SELECTABLE.
 ;;^DD(50.31,.06,12.1)
 ;;=S DIC("S")="I $P(^(0),""^"")'=""ORAL"",$P(^(0),""^"",4)"
 ;;^DD(50.31,.06,20,0)
 ;;=^.3LA^1^1
 ;;^DD(50.31,.06,20,1,0)
 ;;=PS
 ;;^DD(50.31,.06,21,0)
 ;;=^^2^2^2910818^^^^
 ;;^DD(50.31,.06,21,1,0)
 ;;=  If a MED ROUTE is entered here, that med route is used as a DEFAULT value
 ;;^DD(50.31,.06,21,2,0)
 ;;=during order entry when this drug is selected.
 ;;^DD(50.31,.06,"DT")
 ;;=2910818
 ;;^DD(50.31,.07,0)
 ;;=SCHEDULE TYPE^S^OC:ON CALL;O:ONE TIME;P:PRN;R:FILL on REQUEST;^0;7^Q
 ;;^DD(50.31,.07,.1)
 ;;=
 ;;^DD(50.31,.07,3)
 ;;=Enter the most common SCHEDULE TYPE associated with this medication.
 ;;^DD(50.31,.07,20,0)
 ;;=^.3LA^1^1
 ;;^DD(50.31,.07,20,1,0)
 ;;=PS
 ;;^DD(50.31,.07,21,0)
 ;;=^^2^2^2911107^^^^
 ;;^DD(50.31,.07,21,1,0)
 ;;=  If a SCHEDULE TYPE is entered here, it is used as a DEFAULT value in order
 ;;^DD(50.31,.07,21,2,0)
 ;;=entry when this drug is selected.
 ;;^DD(50.31,.07,"DT")
 ;;=2910818
 ;;^DD(50.31,.08,0)
 ;;=SCHEDULE^FX^^0;8^K:X[""""!($A(X)=45)!($L(X," ")>2)!($L(X)>70)!($L(X)<1) X D:$D(X)#2 EN^PSGS0 I $D(X)#2,'PSGS0Y,PSGS0XT W "  Every ",PSGS0XT," minutes"
 ;;^DD(50.31,.08,.1)
 ;;=
 ;;^DD(50.31,.08,3)
 ;;=Enter the most common SCHEDULE associated with this medication.
 ;;^DD(50.31,.08,20,0)
 ;;=^.3LA^1^1
 ;;^DD(50.31,.08,20,1,0)
 ;;=PS
 ;;^DD(50.31,.08,21,0)
 ;;=^^2^2^2910818^^^^
 ;;^DD(50.31,.08,21,1,0)
 ;;=  If a SCHEDULE is entered here, it will be used as a DEFAULT value during
 ;;^DD(50.31,.08,21,2,0)
 ;;=order entry when this drug is selected.
 ;;^DD(50.31,.08,"DT")
 ;;=2910818
 ;;^DD(50.31,1,0)
 ;;=FORMULARY ALTERNATIVE^50.311P^^1;0
 ;;^DD(50.31,1,20,0)
 ;;=^.3LA^1^1
 ;;^DD(50.31,1,20,1,0)
 ;;=PS
 ;;^DD(50.31,1,21,0)
 ;;=^^1^1^2911220^
 ;;^DD(50.31,1,21,1,0)
 ;;=  These are formulary alternatives to this non-formulary primary drug.
 ;;^DD(50.311,0)
 ;;=FORMULARY ALTERNATIVE SUB-FIELD^^.01^1
 ;;^DD(50.311,0,"DT")
 ;;=2920224
 ;;^DD(50.311,0,"IX","B",50.311,.01)
 ;;=
 ;;^DD(50.311,0,"NM","FORMULARY ALTERNATIVE")
 ;;=
 ;;^DD(50.311,0,"UP")
 ;;=50.31
 ;;^DD(50.311,.01,0)
 ;;=FORMULARY ALTERNATIVE^M*P50.3'^PS(50.3,^0;1^S DIC("S")=$P($G(^PS(50.3,D0,1,D1,0)),"^"),DIC("S")=$S(DIC("S")]"":"I +Y'="_D0_",$G(^PS(50.3,+Y,1,""AFI"","""_DIC("S")_"""))",1:"I 0") D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X
 ;;^DD(50.311,.01,1,0)
 ;;=^.1
 ;;^DD(50.311,.01,1,1,0)
 ;;=50.311^B
 ;;^DD(50.311,.01,1,1,1)
 ;;=S ^PS(50.3,DA(2),1,DA(1),1,"B",$E(X,1,30),DA)=""
 ;;^DD(50.311,.01,1,1,2)
 ;;=K ^PS(50.3,DA(2),1,DA(1),1,"B",$E(X,1,30),DA)
 ;;^DD(50.311,.01,3)
 ;;=Enter a formulary drug that may be used as an alternative to this non-formulary drug.
 ;;^DD(50.311,.01,12)
 ;;=Alternative must be a formulary item and be marked for this application.
 ;;^DD(50.311,.01,12.1)
 ;;=S DIC("S")=$P($G(^PS(50.3,D0,1,D1,0)),"^"),DIC("S")=$S(DIC("S")]"":"I +Y'="_D0_",$G(^PS(50.3,+Y,1,""AFI"","""_DIC("S")_"""))",1:"I 0")
 ;;^DD(50.311,.01,20,0)
 ;;=^.3LA^1^1
 ;;^DD(50.311,.01,20,1,0)
 ;;=PS
 ;;^DD(50.311,.01,21,0)
 ;;=^^3^3^2911220^^^
 ;;^DD(50.311,.01,21,1,0)
 ;;=  This is a formulary alternative to this non-formulary drug.  Any 
 ;;^DD(50.311,.01,21,2,0)
 ;;=formulary alternatives entered here are shown to non-pharmacists
 ;;^DD(50.311,.01,21,3,0)
 ;;=whenever they attempt to order this non-formulary drug.

PSJ4I010
PSJ4I010 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 Q:'DIFQ(50.3)  F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^DD(50.311,.01,"DT")
 ;;=2920224
 ;;^DD(50.32,0)
 ;;=SYNONYM SUB-FIELD^^.01^1
 ;;^DD(50.32,0,"DT")
 ;;=2920315
 ;;^DD(50.32,0,"IX","B",50.32,.01)
 ;;=
 ;;^DD(50.32,0,"NM","SYNONYM")
 ;;=
 ;;^DD(50.32,0,"UP")
 ;;=50.3
 ;;^DD(50.32,.01,0)
 ;;=SYNONYM^MF^^0;1^K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>30!($L(X)<1) X
 ;;^DD(50.32,.01,1,0)
 ;;=^.1
 ;;^DD(50.32,.01,1,1,0)
 ;;=50.32^B
 ;;^DD(50.32,.01,1,1,1)
 ;;=S ^PS(50.3,DA(1),2,"B",$E(X,1,30),DA)=""
 ;;^DD(50.32,.01,1,1,2)
 ;;=K ^PS(50.3,DA(1),2,"B",$E(X,1,30),DA)
 ;;^DD(50.32,.01,1,2,0)
 ;;=50.3^C
 ;;^DD(50.32,.01,1,2,1)
 ;;=S ^PS(50.3,"C",$E(X,1,30),DA(1),DA)=""
 ;;^DD(50.32,.01,1,2,2)
 ;;=K ^PS(50.3,"C",$E(X,1,30),DA(1),DA)
 ;;^DD(50.32,.01,1,2,3)
 ;;=Used for look-up.
 ;;^DD(50.32,.01,1,2,"%D",0)
 ;;=^^1^1^2920315^
 ;;^DD(50.32,.01,1,2,"%D",1,0)
 ;;=  This allows users to select file entries by their synonym(s).
 ;;^DD(50.32,.01,1,2,"DT")
 ;;=2920315
 ;;^DD(50.32,.01,3)
 ;;=Answer must be 1-30 characters in length.
 ;;^DD(50.32,.01,21,0)
 ;;=^^2^2^2920315^
 ;;^DD(50.32,.01,21,1,0)
 ;;=  This allows alternate names, such as trade names, to be entered for
 ;;^DD(50.32,.01,21,2,0)
 ;;=primary drugs, allowing primary drugs to be selected by the alternate names.
 ;;^DD(50.32,.01,23,0)
 ;;=^^3^3^2920315^
 ;;^DD(50.32,.01,23,1,0)
 ;;=  This allows users to provide alternate names for the entries in this
 ;;^DD(50.32,.01,23,2,0)
 ;;=file.  Users can then select entries from this file by these alternate
 ;;^DD(50.32,.01,23,3,0)
 ;;=names through a regular 'C' cross-reference.
 ;;^DD(50.32,.01,"DT")
 ;;=2920315

PSJ4I011
PSJ4I011 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 Q:'DIFQ(50.35)  F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^DIC(50.35,0,"GL")
 ;;=^PS(50.35,
 ;;^DIC("B","DRUG APPLICATION",50.35)
 ;;=
 ;;^DIC(50.35,"%",0)
 ;;=^1.005^1^1
 ;;^DIC(50.35,"%",1,0)
 ;;=PS
 ;;^DIC(50.35,"%","B","PS",1)
 ;;=
 ;;^DIC(50.35,"%D",0)
 ;;=^^4^4^2911220^
 ;;^DIC(50.35,"%D",1,0)
 ;;=  This file contains applications and their one character codes.  These
 ;;^DIC(50.35,"%D",2,0)
 ;;=codes are used by the APPLICATION field of the PRIMARY DRUG file.
 ;;^DIC(50.35,"%D",3,0)
 ;;= 
 ;;^DIC(50.35,"%D",4,0)
 ;;=  THESE CODES (OTHER THAN 'Z' OR 'z') MUST BE ASSIGNED BY THE BIRMINGHAM ISC!!
 ;;^DD(50.35,0)
 ;;=FIELD^^.02^2
 ;;^DD(50.35,0,"DDA")
 ;;=N
 ;;^DD(50.35,0,"DT")
 ;;=2910819
 ;;^DD(50.35,0,"ID",.02)
 ;;=W "   ",$P(^(0),U,2)
 ;;^DD(50.35,0,"IX","B",50.35,.01)
 ;;=
 ;;^DD(50.35,0,"IX","C",50.35,.02)
 ;;=
 ;;^DD(50.35,0,"NM","DRUG APPLICATION")
 ;;=
 ;;^DD(50.35,.01,0)
 ;;=NAME^RF^^0;1^K:$L(X)>60!($L(X)<2)!'(X'?1P.E) X
 ;;^DD(50.35,.01,1,0)
 ;;=^.1
 ;;^DD(50.35,.01,1,1,0)
 ;;=50.35^B
 ;;^DD(50.35,.01,1,1,1)
 ;;=S ^PS(50.35,"B",$E(X,1,30),DA)=""
 ;;^DD(50.35,.01,1,1,2)
 ;;=K ^PS(50.35,"B",$E(X,1,30),DA)
 ;;^DD(50.35,.01,3)
 ;;=Enter the name of an application that will be using entries in the Primary Drug file.
 ;;^DD(50.35,.01,20,0)
 ;;=^.3LA^1^1
 ;;^DD(50.35,.01,20,1,0)
 ;;=PS
 ;;^DD(50.35,.01,21,0)
 ;;=^^2^2^2911220^^
 ;;^DD(50.35,.01,21,1,0)
 ;;=  This is an application that may make use of the entries within the Primary
 ;;^DD(50.35,.01,21,2,0)
 ;;=Drug file.
 ;;^DD(50.35,.01,23,0)
 ;;=^^2^2^2911220^
 ;;^DD(50.35,.01,23,1,0)
 ;;=  If an application (DHCP package) would like to use entries within the
 ;;^DD(50.35,.01,23,2,0)
 ;;=Primary Drug file, it must first have an entry in this file.
 ;;^DD(50.35,.01,"DT")
 ;;=2910819
 ;;^DD(50.35,.02,0)
 ;;=CODE^FX^^0;2^K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>1!($L(X)<1) X I $D(X) S X(1)=$O(^PS(53.35,"C",X,0)) I X(1) S X(2)=$P($G(^PS(50.35,X(1),0)),"^") S:X(2)="" X(2)=X(1) K X W !,"THIS CODE IS ALREADY USED BY ",X(2)
 ;;^DD(50.35,.02,1,0)
 ;;=^.1
 ;;^DD(50.35,.02,1,1,0)
 ;;=50.35^C
 ;;^DD(50.35,.02,1,1,1)
 ;;=S ^PS(50.35,"C",$E(X,1,30),DA)=""
 ;;^DD(50.35,.02,1,1,2)
 ;;=K ^PS(50.35,"C",$E(X,1,30),DA)
 ;;^DD(50.35,.02,1,1,3)
 ;;=USED FOR LOOK-UP.
 ;;^DD(50.35,.02,1,1,"DT")
 ;;=2910819
 ;;^DD(50.35,.02,3)
 ;;=Answer must be 1 character in length.
 ;;^DD(50.35,.02,20,0)
 ;;=^.3LA^1^1
 ;;^DD(50.35,.02,20,1,0)
 ;;=PS
 ;;^DD(50.35,.02,21,0)
 ;;=^^2^2^2910819^
 ;;^DD(50.35,.02,21,1,0)
 ;;=  This is the code for this application.  This code is stored with the drugs
 ;;^DD(50.35,.02,21,2,0)
 ;;=associated with this application.
 ;;^DD(50.35,.02,"DT")
 ;;=2911220

PSJ4I012
PSJ4I012 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 Q:'DIFQR(50.35)  F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^UTILITY(U,$J,50.35)
 ;;=^PS(50.35,
 ;;^UTILITY(U,$J,50.35,0)
 ;;=DRUG APPLICATION^50.35I^7^7
 ;;^UTILITY(U,$J,50.35,1,0)
 ;;=UNIT DOSE MEDICATIONS^U
 ;;^UTILITY(U,$J,50.35,2,0)
 ;;=OUTPATIENT PHARMACY^O
 ;;^UTILITY(U,$J,50.35,3,0)
 ;;=IV MEDICATIONS^I
 ;;^UTILITY(U,$J,50.35,4,0)
 ;;=SURGERY^S
 ;;^UTILITY(U,$J,50.35,5,0)
 ;;=ONCOLOGY^C
 ;;^UTILITY(U,$J,50.35,6,0)
 ;;=CONTROLLED SUBSTANCES^N
 ;;^UTILITY(U,$J,50.35,7,0)
 ;;=MEDICINE^M

PSJ4I013
PSJ4I013 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 Q:'DIFQ(52.6)  F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^DIC(52.6,0,"GL")
 ;;=^PS(52.6,
 ;;^DIC("B","IV ADDITIVES",52.6)
 ;;=
 ;;^DIC(52.6,"%",0)
 ;;=^1.005^1^1
 ;;^DIC(52.6,"%",1,0)
 ;;=PSJI
 ;;^DIC(52.6,"%","B","PSJI",1)
 ;;=
 ;;^DIC(52.6,"%D",0)
 ;;=^^7^7^2910226^^^
 ;;^DIC(52.6,"%D",1,0)
 ;;=  The IV ADDITIVES file contains drugs which will be used as additives
 ;;^DIC(52.6,"%D",2,0)
 ;;=in the IV room. Any drug entered in this file must already exist in
 ;;^DIC(52.6,"%D",3,0)
 ;;=the DRUG file (50). All drug information relating to its use in the
 ;;^DIC(52.6,"%D",4,0)
 ;;=IV package is stored in the IV ADDITIVES file. If a drug is no longer
 ;;^DIC(52.6,"%D",5,0)
 ;;=to be used as an IV additive, DO NOT delete it from the IV ADDITIVE
 ;;^DIC(52.6,"%D",6,0)
 ;;=file, but simply inactivate it by entering the date it is to be dis-
 ;;^DIC(52.6,"%D",7,0)
 ;;=continued in the INACTIVATION field.
 ;;^DD(52.6,0)
 ;;=FIELD^^16^17
 ;;^DD(52.6,0,"DT")
 ;;=2911121
 ;;^DD(52.6,0,"ID",2)
 ;;=W ""
 ;;^DD(52.6,0,"ID","WRITE")
 ;;=W:$D(^PSDRUG(+$P(^PS(52.6,+Y,0),"^",2),0)) !?15,$P(^(0),"^",10) I $D(DD),DD F PSIV=0:0 S PSIV=$O(^PS(52.6,+Y,1,PSIV)) Q:'PSIV  W !?7,"- ",$P(^(PSIV,0),"^")," -"
 ;;^DD(52.6,0,"IX","AAP",52.6,1)
 ;;=
 ;;^DD(52.6,0,"IX","AAP",52.7,1)
 ;;=
 ;;^DD(52.6,0,"IX","AC",52.6,1)
 ;;=
 ;;^DD(52.6,0,"IX","APD",52.6,16)
 ;;=
 ;;^DD(52.6,0,"IX","B",52.6,.01)
 ;;=
 ;;^DD(52.6,0,"IX","C",52.61,.01)
 ;;=
 ;;^DD(52.6,0,"IX","D",52.63,.01)
 ;;=
 ;;^DD(52.6,0,"NM","IV ADDITIVES")
 ;;=
 ;;^DD(52.6,0,"PT",50.2,1)
 ;;=
 ;;^DD(52.6,0,"PT",50.21,.01)
 ;;=
 ;;^DD(52.6,0,"PT",53.157,.01)
 ;;=
 ;;^DD(52.6,0,"PT",55.02,.01)
 ;;=
 ;;^DD(52.6,0,"PT",57.17,.01)
 ;;=
 ;;^DD(52.6,.01,0)
 ;;=PRINT NAME^RX^^0;1^K:$L(X)>30!(X?.N)!($L(X)<3)!'(X'?1P.E)!(X'?.ANP) X
 ;;^DD(52.6,.01,.1)
 ;;= 
 ;;^DD(52.6,.01,1,0)
 ;;=^.1^^-1
 ;;^DD(52.6,.01,1,1,0)
 ;;=52.6^B
 ;;^DD(52.6,.01,1,1,1)
 ;;=S ^PS(52.6,"B",$E(X,1,30),DA)=""
 ;;^DD(52.6,.01,1,1,2)
 ;;=K ^PS(52.6,"B",$E(X,1,30),DA)
 ;;^DD(52.6,.01,3)
 ;;=Name must be 3-30 characters, not numeric or starting with punctuation.
 ;;^DD(52.6,.01,4)
 ;;=
 ;;^DD(52.6,.01,20,0)
 ;;=^.3LA^1^1
 ;;^DD(52.6,.01,20,1,0)
 ;;=PSJI
 ;;^DD(52.6,.01,21,0)
 ;;=^^4^4^2910510^^^^
 ;;^DD(52.6,.01,21,1,0)
 ;;=  This field should contain the print name of the 'GENERIC DRUG' (file #50).
 ;;^DD(52.6,.01,21,2,0)
 ;;=The print name entered here will be printed on the IV label, Ward list,
 ;;^DD(52.6,.01,21,3,0)
 ;;=Manufacturing list etc.  It should not contain strength, since strength
 ;;^DD(52.6,.01,21,4,0)
 ;;=is entered with each individual IV order.
 ;;^DD(52.6,.01,"DT")
 ;;=2871214
 ;;^DD(52.6,1,0)
 ;;=GENERIC DRUG^R*P50'^PSDRUG(^0;2^S DIC("S")="I '$P($G(^PSDRUG(+Y,2)),""^"",5)"_$S($D(DRUGEDIT):"",1:",$S('$G(^(""I"")):1,1:^(""I"")'<DT)") D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X
 ;;^DD(52.6,1,1,0)
 ;;=^.1
 ;;^DD(52.6,1,1,1,0)
 ;;=52.6^AC
 ;;^DD(52.6,1,1,1,1)
 ;;=S ^PS(52.6,"AC",$E(X,1,30),DA)=""
 ;;^DD(52.6,1,1,1,2)
 ;;=K ^PS(52.6,"AC",$E(X,1,30),DA)
 ;;^DD(52.6,1,1,2,0)
 ;;=52.6^AAP^MUMPS
 ;;^DD(52.6,1,1,2,1)
 ;;=I $P($G(^PSDRUG(X,2)),"^",3)'["I" S PSIUDA=X,PSIUX="I" D ENS^PSGIU
 ;;^DD(52.6,1,1,2,2)
 ;;=I '$D(^PS(52.7,"AC",X)) S XX=$O(^PS(52.6,"AC",X,0)) S:XX=DA XX=$O(^(XX)) I XX,$P($G(^PSDRUG(X,2)),"^",3)["I" S PSIUDA=X,PSIUX="I" D END^PSGIU
 ;;^DD(52.6,1,1,2,3)
 ;;=Updates the Application Package's Use field for the generic drug selected.
 ;;^DD(52.6,1,1,2,"%D",0)
 ;;=^^2^2^2910805^

PSJ4I014
PSJ4I014 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 Q:'DIFQ(52.6)  F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^DD(52.6,1,1,2,"%D",1,0)
 ;;=  This is used to automatically update the Application Packages' use field
 ;;^DD(52.6,1,1,2,"%D",2,0)
 ;;=in the Drug file for the generic drug selected.
 ;;^DD(52.6,1,1,2,"DT")
 ;;=2910805
 ;;^DD(52.6,1,1,3,0)
 ;;=^^TRIGGER^52.6^16
 ;;^DD(52.6,1,1,3,1)
 ;;=K DIV S (DIV,X)=$P($G(^PSDRUG(X,2)),U,6) I DIV S DIU=$P($G(^PS(52.6,DA,0)),U,12) I DIV'=DIU S $P(^(0),U,12)=DIV I $O(^DD(52.6,16,1,0)) S (D0,DIV(0))=DA,DIH=52.6,DIG=16 D ^DICR
 ;;^DD(52.6,1,1,3,2)
 ;;=S DIU=$P($G(^PS(52.6,DA,0)),U,12) I DIU]"" S $P(^(0),U,12)="" I $O(^DD(52.6,16,1,0)) K DIV S (DIV,X)="",(D0,DIV(0))=DA,DIH=52.6,DIG=16 D ^DICR
 ;;^DD(52.6,1,1,3,3)
 ;;=Needed to update the PRIMARY DRUG.
 ;;^DD(52.6,1,1,3,"%D",0)
 ;;=^^4^4^2911126^^^^
 ;;^DD(52.6,1,1,3,"%D",1,0)
 ;;=  Used to update the PRIMARY DRUG field (16) when the additive's GENERIC
 ;;^DD(52.6,1,1,3,"%D",2,0)
 ;;=DRUG field (1) is changed. The primary drug field will only be updated if
 ;;^DD(52.6,1,1,3,"%D",3,0)
 ;;=the generic drug entered has been matched to a primary drug in the PRIMARY
 ;;^DD(52.6,1,1,3,"%D",4,0)
 ;;=DRUG file (50.3).
 ;;^DD(52.6,1,1,3,"CREATE VALUE")
 ;;=GENERIC DRUG:#64
 ;;^DD(52.6,1,1,3,"DELETE VALUE")
 ;;=@
 ;;^DD(52.6,1,1,3,"DT")
 ;;=2911002
 ;;^DD(52.6,1,1,3,"FIELD")
 ;;=PRIMARY DRUG
 ;;^DD(52.6,1,12)
 ;;=INACTIVE DRUGS ARE NOT SELECTABLE
 ;;^DD(52.6,1,12.1)
 ;;=S DIC("S")="I '$P($G(^PSDRUG(+Y,2)),""^"",5)"_$S($D(DRUGEDIT):"",1:",$S('$G(^(""I"")):1,1:^(""I"")'<DT)")
 ;;^DD(52.6,1,20,0)
 ;;=^.3LA^1^1
 ;;^DD(52.6,1,20,1,0)
 ;;=PSJI
 ;;^DD(52.6,1,21,0)
 ;;=^^2^2^2910305^^^^
 ;;^DD(52.6,1,21,1,0)
 ;;=  This field is the pointer from the IV ADDITIVES (52.6) to the DRUG file
 ;;^DD(52.6,1,21,2,0)
 ;;=(#50).  This can be considered a link between both files.
 ;;^DD(52.6,1,"DT")
 ;;=2911002
 ;;^DD(52.6,15,0)
 ;;=TYPE^S^1:ELECTROLYTE;2:MULTIVITAMIN;^0;11^Q
 ;;^DD(52.6,15,3)
 ;;=ENTER "E" FOR ELECTROLYTE, OR "M" FOR MULTIVITAMIN
 ;;^DD(52.6,15,21,0)
 ;;=^^3^3^2920220^^^^
 ;;^DD(52.6,15,21,1,0)
 ;;=  Identifies the additive as an electrolyte or a multivitamin. Only 
 ;;^DD(52.6,15,21,2,0)
 ;;=additives identified as electrolytes or multivitamins may be selected
 ;;^DD(52.6,15,21,3,0)
 ;;=in IV Fluid order entry.
 ;;^DD(52.6,15,23,0)
 ;;=^^2^2^2920220^^^^
 ;;^DD(52.6,15,23,1,0)
 ;;=  Used to limit additive selection in physician order entry and Pharmacy 
 ;;^DD(52.6,15,23,2,0)
 ;;=completion of IV fluid orders to only electrolytes and multivitamins.
 ;;^DD(52.6,15,"DT")
 ;;=2910717
 ;;^DD(52.6,16,0)
 ;;=PRIMARY DRUG^RP50.3'^PS(50.3,^0;12^Q
 ;;^DD(52.6,16,1,0)
 ;;=^.1
 ;;^DD(52.6,16,1,1,0)
 ;;=52.6^APD
 ;;^DD(52.6,16,1,1,1)
 ;;=S ^PS(52.6,"APD",$E(X,1,30),DA)=""
 ;;^DD(52.6,16,1,1,2)
 ;;=K ^PS(52.6,"APD",$E(X,1,30),DA)
 ;;^DD(52.6,16,1,1,"%D",0)
 ;;=^^2^2^2920123^
 ;;^DD(52.6,16,1,1,"%D",1,0)
 ;;=  Used to check if an additive is linked to an order's primary drug if
 ;;^DD(52.6,16,1,1,"%D",2,0)
 ;;=the order is a "non-fluid" type.
 ;;^DD(52.6,16,1,1,"DT")
 ;;=2920123
 ;;^DD(52.6,16,5,1,0)
 ;;=52.6^1^3
 ;;^DD(52.6,16,5,2,0)
 ;;=50^64^4
 ;;^DD(52.6,16,21,0)
 ;;=^^2^2^2920511^^
 ;;^DD(52.6,16,21,1,0)
 ;;=  Links the additive in the IV ADDITIVES file (52.6) to a primary drug
 ;;^DD(52.6,16,21,2,0)
 ;;=in the PRIMARY DRUG file (50.3).
 ;;^DD(52.6,16,23,0)
 ;;=^^2^2^2920511^^
 ;;^DD(52.6,16,23,1,0)
 ;;=  When the GENERIC DRUG field is edited, the primary drug linked to the

PSJ4I015
PSJ4I015 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 Q:'DIFQ(52.6)  F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^DD(52.6,16,23,2,0)
 ;;=generic drug entered for the additive is triggered into this field.
 ;;^DD(52.6,16,"DT")
 ;;=2920123

PSJ4I016
PSJ4I016 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 Q:'DIFQ(52.7)  F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^DIC(52.7,0,"GL")
 ;;=^PS(52.7,
 ;;^DIC("B","IV SOLUTIONS",52.7)
 ;;=
 ;;^DIC(52.7,"%",0)
 ;;=^1.005^1^1
 ;;^DIC(52.7,"%",1,0)
 ;;=PSJI
 ;;^DIC(52.7,"%","B","PSJI",1)
 ;;=
 ;;^DIC(52.7,"%D",0)
 ;;=^^7^7^2910305^
 ;;^DIC(52.7,"%D",1,0)
 ;;=  The IV SOLUTIONS file contains drugs which will be used as the primary
 ;;^DIC(52.7,"%D",2,0)
 ;;=solutions in the IV room.  Any drug entered in this file must already 
 ;;^DIC(52.7,"%D",3,0)
 ;;=exist in the DRUG file (50).  All drug information relating to its use
 ;;^DIC(52.7,"%D",4,0)
 ;;=in the IV package is stored in the IV SOLUTIONS file.  If a drug is no
 ;;^DIC(52.7,"%D",5,0)
 ;;=longer to be used as an IV solution, DO NOT delete it from the IV SOLUTIONS
 ;;^DIC(52.7,"%D",6,0)
 ;;=file, but simply inactivate it by entering the date it is to be discontinued
 ;;^DIC(52.7,"%D",7,0)
 ;;=in the INACTIVATION DATE field.
 ;;^DD(52.7,0)
 ;;=FIELD^^16^11
 ;;^DD(52.7,0,"DT")
 ;;=2910930
 ;;^DD(52.7,0,"ID",.02)
 ;;=W "   ",$P(^(0),U,4)
 ;;^DD(52.7,0,"ID",2)
 ;;=W "   ",$P(^(0),U,3)
 ;;^DD(52.7,0,"ID","WRITE")
 ;;=I $D(^PSDRUG(+$P(^PS(52.7,+Y,0),"^",2),0)) W !?15,$P(^(0),"^",10)
 ;;^DD(52.7,0,"IX","AAP",52.7,1)
 ;;=
 ;;^DD(52.7,0,"IX","AC",52.7,1)
 ;;=
 ;;^DD(52.7,0,"IX","APD",52.7,16)
 ;;=
 ;;^DD(52.7,0,"IX","B",52.7,.01)
 ;;=
 ;;^DD(52.7,0,"IX","D",52.703,.01)
 ;;=
 ;;^DD(52.7,0,"NM","IV SOLUTIONS")
 ;;=
 ;;^DD(52.7,0,"PT",50.2,1)
 ;;=
 ;;^DD(52.7,0,"PT",50.21,.01)
 ;;=
 ;;^DD(52.7,0,"PT",52.61,6)
 ;;=
 ;;^DD(52.7,0,"PT",53.158,.01)
 ;;=
 ;;^DD(52.7,0,"PT",55.11,.01)
 ;;=
 ;;^DD(52.7,0,"PT",57.18,.01)
 ;;=
 ;;^DD(52.7,.01,0)
 ;;=PRINT NAME^RF^^0;1^K:$L(X)>30!($L(X)<3)!'(X'?1P.E)!(X'?.ANP) X
 ;;^DD(52.7,.01,1,0)
 ;;=^.1
 ;;^DD(52.7,.01,1,1,0)
 ;;=52.7^B
 ;;^DD(52.7,.01,1,1,1)
 ;;=S ^PS(52.7,"B",$E(X,1,30),DA)=""
 ;;^DD(52.7,.01,1,1,2)
 ;;=K ^PS(52.7,"B",$E(X,1,30),DA)
 ;;^DD(52.7,.01,3)
 ;;=Answer must be 3-30 characters in length.
 ;;^DD(52.7,.01,20,0)
 ;;=^.3LA^1^1
 ;;^DD(52.7,.01,20,1,0)
 ;;=PSJI
 ;;^DD(52.7,.01,21,0)
 ;;=^^4^4^2910305^^^^
 ;;^DD(52.7,.01,21,1,0)
 ;;=  This field should contain the print name of the solution.  The
 ;;^DD(52.7,.01,21,2,0)
 ;;=name that is entered here will be printed on the IV label, manufacturing
 ;;^DD(52.7,.01,21,3,0)
 ;;=list, ward list, etc.  The volume should NOT be part of the print name,
 ;;^DD(52.7,.01,21,4,0)
 ;;=since the volume of the IV ORDER will be printed next to the print name.
 ;;^DD(52.7,.01,"DT")
 ;;=2900406
 ;;^DD(52.7,1,0)
 ;;=GENERIC DRUG^R*P50'^PSDRUG(^0;2^S DIC("S")="I '$P($G(^PSDRUG(+Y,2)),""^"",5)"_$S($D(DRUGEDIT):"",1:",$S('$G(^(""I"")):1,1:^(""I"")'<DT)") D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X
 ;;^DD(52.7,1,1,0)
 ;;=^.1
 ;;^DD(52.7,1,1,1,0)
 ;;=52.7^AC
 ;;^DD(52.7,1,1,1,1)
 ;;=S ^PS(52.7,"AC",$E(X,1,30),DA)=""
 ;;^DD(52.7,1,1,1,2)
 ;;=K ^PS(52.7,"AC",$E(X,1,30),DA)
 ;;^DD(52.7,1,1,2,0)
 ;;=52.6^AAP^MUMPS
 ;;^DD(52.7,1,1,2,1)
 ;;=I $P($G(^PSDRUG(X,2)),"^",3)'["I" S PSIUDA=X,PSIUX="I" D ENS^PSGIU K PSIUDA,PSIUX
 ;;^DD(52.7,1,1,2,2)
 ;;=I '$D(^PS(52.6,"AC",X)) S XX=$O(^PS(52.7,"AC",X,0)) S:XX=DA XX=$O(^(XX)) I XX,$P($G(^PSDRUG(X,2)),"^",3)["I" S PSIUDA=X,PSIUX="I" D END^PSGIU K PSIUDA,PSIUX
 ;;^DD(52.7,1,1,2,3)
 ;;=Updates the Application Package's Use field for the generic drug selected.
 ;;^DD(52.7,1,1,2,"%D",0)
 ;;=^^2^2^2911126^^
 ;;^DD(52.7,1,1,2,"%D",1,0)
 ;;=  This is used to automatically update the Application Packages' use field

PSJ4I017
PSJ4I017 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 Q:'DIFQ(52.7)  F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^DD(52.7,1,1,2,"%D",2,0)
 ;;=in the Drug file for the generic drug selected.
 ;;^DD(52.7,1,1,2,"DT")
 ;;=2911126
 ;;^DD(52.7,1,1,3,0)
 ;;=^^TRIGGER^52.7^16
 ;;^DD(52.7,1,1,3,1)
 ;;=K DIV S (DIV,X)=$P($G(^PSDRUG(X,2)),"^",6) I DIV S DIU=$P($G(^PS(52.7,DA,0)),"^",12) I DIV'=DIU S $P(^(0),"^",12)=DIV I $O(^DD(52.7,16,1,0)) S (D0,DIV(0))=DA,DIH=52.7,DIG=16 D ^DICR
 ;;^DD(52.7,1,1,3,2)
 ;;=S DIU=$P($G(^PS(52.7,DA,0)),"^",12) I DIU]"" S $P(^(0),"^",12)="" I $O(^DD(52.7,16,1,0)) K DIV S (DIV,X)="",(D0,DIV(0))=DA,DIH=52.7,DIG=16 D ^DICR
 ;;^DD(52.7,1,1,3,3)
 ;;=Needed to update the PRIMARY DRUG field.
 ;;^DD(52.7,1,1,3,"%D",0)
 ;;=^^4^4^2911126^
 ;;^DD(52.7,1,1,3,"%D",1,0)
 ;;=  Used to update the PRIMARY DRUG field (16) when the solution's GENERIC
 ;;^DD(52.7,1,1,3,"%D",2,0)
 ;;=DRUG field (1) is changed.  The primary drug field will only be updated if
 ;;^DD(52.7,1,1,3,"%D",3,0)
 ;;=the generic drug entered has been matched to a primary drug in the PRIMARY
 ;;^DD(52.7,1,1,3,"%D",4,0)
 ;;=DRUG file (50.3).
 ;;^DD(52.7,1,1,3,"CREATE VALUE")
 ;;=GENERIC DRUG:#64
 ;;^DD(52.7,1,1,3,"DELETE VALUE")
 ;;=@
 ;;^DD(52.7,1,1,3,"DT")
 ;;=2911002
 ;;^DD(52.7,1,1,3,"FIELD")
 ;;=PRIMARY DRUG
 ;;^DD(52.7,1,12)
 ;;=INACTIVE DRUGS ARE NOT SELECTABLE
 ;;^DD(52.7,1,12.1)
 ;;=S DIC("S")="I '$P($G(^PSDRUG(+Y,2)),""^"",5)"_$S($D(DRUGEDIT):"",1:",$S('$G(^(""I"")):1,1:^(""I"")'<DT)")
 ;;^DD(52.7,1,20,0)
 ;;=^.3LA^1^1
 ;;^DD(52.7,1,20,1,0)
 ;;=PSJI
 ;;^DD(52.7,1,21,0)
 ;;=^^1^1^2911003^^^^
 ;;^DD(52.7,1,21,1,0)
 ;;=  This field will link the IV Solution file (#52.7) to the drug file (#50).
 ;;^DD(52.7,1,"DT")
 ;;=2911126
 ;;^DD(52.7,9,0)
 ;;=USED IN IV FLUID ORDER ENTRY^*S^1:YES;0:NO;^0;11^Q
 ;;^DD(52.7,9,12)
 ;;=Only solutions with no data in the PRINT NAME {2} field may be selected.
 ;;^DD(52.7,9,12.1)
 ;;=S DIC("S")="I $P(^PS(52.7,DA,0),U,4)="""""
 ;;^DD(52.7,9,21,0)
 ;;=^^3^3^2920221^^^^
 ;;^DD(52.7,9,21,1,0)
 ;;= Allows pharmacy to limit the solutions available in IV Fluid order entry. 
 ;;^DD(52.7,9,21,2,0)
 ;;=Solutions having data in the PRINT NAME {2} field are assumed to be 
 ;;^DD(52.7,9,21,3,0)
 ;;=multi-ingredient drugs, and are not selectable.
 ;;^DD(52.7,9,23,0)
 ;;=^^3^3^2920221^^^^
 ;;^DD(52.7,9,23,1,0)
 ;;= Limits solutions used in clinician IV Fluid order entry to single ingredient 
 ;;^DD(52.7,9,23,2,0)
 ;;=drugs only. Solutions with data in the PRINT NAME {2} field (.02) are now 
 ;;^DD(52.7,9,23,3,0)
 ;;=allowed to be marked.
 ;;^DD(52.7,9,"DT")
 ;;=2910925
 ;;^DD(52.7,16,0)
 ;;=PRIMARY DRUG^RP50.3'^PS(50.3,^0;12^Q
 ;;^DD(52.7,16,1,0)
 ;;=^.1
 ;;^DD(52.7,16,1,1,0)
 ;;=52.7^APD
 ;;^DD(52.7,16,1,1,1)
 ;;=S ^PS(52.7,"APD",$E(X,1,30),DA)=""
 ;;^DD(52.7,16,1,1,2)
 ;;=K ^PS(52.7,"APD",$E(X,1,30),DA)
 ;;^DD(52.7,16,1,1,"%D",0)
 ;;=^^2^2^2920123^
 ;;^DD(52.7,16,1,1,"%D",1,0)
 ;;=  Used to check if a solution is linked to an order's primary drug if
 ;;^DD(52.7,16,1,1,"%D",2,0)
 ;;=the order is a "non-fluid" type.
 ;;^DD(52.7,16,1,1,"DT")
 ;;=2920123
 ;;^DD(52.7,16,5,1,0)
 ;;=52.7^1^3
 ;;^DD(52.7,16,5,2,0)
 ;;=50^64^5
 ;;^DD(52.7,16,21,0)
 ;;=^^2^2^2910930^^
 ;;^DD(52.7,16,21,1,0)
 ;;=  Links the solution in the IV SOLUTIONS file (52.7) to a primary drug
 ;;^DD(52.7,16,21,2,0)
 ;;=in the PRIMARY DRUG file (50.3).
 ;;^DD(52.7,16,23,0)
 ;;=^^2^2^2910930^^
 ;;^DD(52.7,16,23,1,0)
 ;;=  When the GENERIC DRUG field is edited, the primary drug linked to the

PSJ4I018
PSJ4I018 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 Q:'DIFQ(52.7)  F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^DD(52.7,16,23,2,0)
 ;;=generic drug entered for the solution is triggered into this field.
 ;;^DD(52.7,16,"DT")
 ;;=2920123

PSJ4I019
PSJ4I019 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 Q:'DIFQ(53.45)  F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^DIC(53.45,0,"GL")
 ;;=^PS(53.45,
 ;;^DIC("B","INPATIENT USER PARAMETERS",53.45)
 ;;=
 ;;^DIC(53.45,"%",0)
 ;;=^1.005^1^1
 ;;^DIC(53.45,"%",1,0)
 ;;=PSJ
 ;;^DIC(53.45,"%","B","PSJ",1)
 ;;=
 ;;^DIC(53.45,"%D",0)
 ;;=^^6^6^2911127^^^
 ;;^DIC(53.45,"%D",1,0)
 ;;=  This file is used to tailor the Inpatient Medications package with regards
 ;;^DIC(53.45,"%D",2,0)
 ;;=to specific users.  Some of these parameters (fields) can be set by the
 ;;^DIC(53.45,"%D",3,0)
 ;;=users, and others can only be set by an Inpatient supervisor.  (A supervisor
 ;;^DIC(53.45,"%D",4,0)
 ;;=is a user who has been assigned the 'PSJU MGR' security key.)
 ;;^DIC(53.45,"%D",5,0)
 ;;=  This file also contains fields that are used as temporary storage of data
 ;;^DIC(53.45,"%D",6,0)
 ;;=during order entry/edit.
 ;;^DD(53.45,0)
 ;;=FIELD^^.12^15
 ;;^DD(53.45,0,"DDA")
 ;;=N
 ;;^DD(53.45,0,"DT")
 ;;=2920125
 ;;^DD(53.45,0,"IX","B",53.45,.01)
 ;;=
 ;;^DD(53.45,0,"NM","INPATIENT USER PARAMETERS")
 ;;=
 ;;^DD(53.45,.01,0)
 ;;=INPATIENT USER^RP200'^VA(200,^0;1^Q
 ;;^DD(53.45,.01,1,0)
 ;;=^.1
 ;;^DD(53.45,.01,1,1,0)
 ;;=53.45^B
 ;;^DD(53.45,.01,1,1,1)
 ;;=S ^PS(53.45,"B",$E(X,1,30),DA)=""
 ;;^DD(53.45,.01,1,1,2)
 ;;=K ^PS(53.45,"B",$E(X,1,30),DA)
 ;;^DD(53.45,.01,3)
 ;;=Select an Inpatient user.
 ;;^DD(53.45,.01,20,0)
 ;;=^.3LA^1^1
 ;;^DD(53.45,.01,20,1,0)
 ;;=PSJ
 ;;^DD(53.45,.01,21,0)
 ;;=^^1^1^2911025^
 ;;^DD(53.45,.01,21,1,0)
 ;;=  This is a user for whom the Inpatient Medications package can be tailored.
 ;;^DD(53.45,.01,"DT")
 ;;=2911025
 ;;^DD(53.45,.01,"LAYGO",1,0)
 ;;=S X(1)=$D(^PS(53.45,"B",$E(X,1,30))) S:X(1) X(2)=$P($G(^VA(200,+X,0)),"^") S:$S(X(1):X(2)="",1:0) X(2)=X W:X(1) !?3,"But an entry for ",X(2)," already exists!" I 'X(1)
 ;;^DD(53.45,.02,0)
 ;;=MAY SELECT DISPENSE DRUGS^S^0:NO;1:YES;^0;2^Q
 ;;^DD(53.45,.02,3)
 ;;=Answer 'YES' if this user can select dispense drugs when entering orders.
 ;;^DD(53.45,.02,20,0)
 ;;=^.3LA^1^1
 ;;^DD(53.45,.02,20,1,0)
 ;;=PSJ
 ;;^DD(53.45,.02,21,0)
 ;;=^^3^3^2910820^^
 ;;^DD(53.45,.02,21,1,0)
 ;;=  Unless the user is a pharmacist, the user can only enter primary drugs
 ;;^DD(53.45,.02,21,2,0)
 ;;=during the Unit Dose order entry process.  Answer 'YES' here if this
 ;;^DD(53.45,.02,21,3,0)
 ;;=user can also enter dispense drugs during order entry.
 ;;^DD(53.45,.02,23,0)
 ;;=^^5^5^2910820^^
 ;;^DD(53.45,.02,23,1,0)
 ;;=  At the drug selection during the Unit Dose order entry process, only
 ;;^DD(53.45,.02,23,2,0)
 ;;=pharmacists may select dispense drugs in addition to primary drugs.  If
 ;;^DD(53.45,.02,23,3,0)
 ;;=this field is set to 'YES', this non-pharmacist may also select dispense
 ;;^DD(53.45,.02,23,4,0)
 ;;=drugs.  If not, the user may only select primary drugs.  This field is
 ;;^DD(53.45,.02,23,5,0)
 ;;=set by the supervisor and not by the user.
 ;;^DD(53.45,.02,"DT")
 ;;=2910820
 ;;^DD(53.45,.03,0)
 ;;=ALLOW USER TO RENEW ORDERS^S^1:YES;0:NO;^0;3^Q
 ;;^DD(53.45,.03,3)
 ;;=Answer 'YES' to allow this ward clerk (or pharmacy technician) to renew orders.
 ;;^DD(53.45,.03,20,0)
 ;;=^.3LA^1^1
 ;;^DD(53.45,.03,20,1,0)
 ;;=PSJ
 ;;^DD(53.45,.03,21,0)
 ;;=^^3^3^2911127^^^^
 ;;^DD(53.45,.03,21,1,0)
 ;;=  If this is set to 'YES', this ward clerk/pharmacy technician may 
 ;;^DD(53.45,.03,21,2,0)
 ;;=actually renew orders for patients on this ward. If this is set to 'NO' 

PSJ4I020
PSJ4I020 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 Q:'DIFQ(53.45)  F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^DD(53.45,.03,21,3,0)
 ;;=(or not set), this clerk/technician can only mark orders to be renewed. 
 ;;^DD(53.45,.03,23,0)
 ;;=^^3^3^2911127^^^
 ;;^DD(53.45,.03,23,1,0)
 ;;=  For ward clerks and pharmacy technicians.  Used by the renewal routines to
 ;;^DD(53.45,.03,23,2,0)
 ;;=determine if the user can renew orders or only mark the orders to be renewed
 ;;^DD(53.45,.03,23,3,0)
 ;;=later by a nurse or pharmacist.  Can only be edited by a supervisor.
 ;;^DD(53.45,.03,"DT")
 ;;=2920119
 ;;^DD(53.45,.04,0)
 ;;=ALLOW USER TO HOLD ORDERS^S^1:YES;0:NO;^0;4^Q
 ;;^DD(53.45,.04,3)
 ;;=Answer 'YES' to allow this ward clerk/pharmacy technician to hold/unhold orders.
 ;;^DD(53.45,.04,20,0)
 ;;=^.3LA^1^1
 ;;^DD(53.45,.04,20,1,0)
 ;;=PSJ
 ;;^DD(53.45,.04,21,0)
 ;;=^^4^4^2911127^^^^
 ;;^DD(53.45,.04,21,1,0)
 ;;=  If this is set to 'YES', this ward clerk/pharmacy technician may actually
 ;;^DD(53.45,.04,21,2,0)
 ;;=place Inpatient orders on hold or take orders off of hold.  If this is set
 ;;^DD(53.45,.04,21,3,0)
 ;;=to 'NO' (or not set), this clerk/technician can only mark orders for 
 ;;^DD(53.45,.04,21,4,0)
 ;;=hold/unhold, and only a pharmacist or nurse can hold/unhold the orders.
 ;;^DD(53.45,.04,23,0)
 ;;=^^3^3^2911127^^^^
 ;;^DD(53.45,.04,23,1,0)
 ;;=  Used by the hold routines to determine if this ward clerk/pharmacy
 ;;^DD(53.45,.04,23,2,0)
 ;;=technician can actually place an order on hold or take an order off of
 ;;^DD(53.45,.04,23,3,0)
 ;;=hold.  Can only be set by a supervisor.
 ;;^DD(53.45,.04,"DT")
 ;;=2920119
 ;;^DD(53.45,.05,0)
 ;;=ALLOW USER TO CANCEL ORDERS^S^1:YES;0:NO;^0;5^Q
 ;;^DD(53.45,.05,3)
 ;;=Answer 'YES' to allow this ward clerk/pharmacy technician to cancel orders.
 ;;^DD(53.45,.05,20,0)
 ;;=^.3LA^1^1
 ;;^DD(53.45,.05,20,1,0)
 ;;=PSJ
 ;;^DD(53.45,.05,21,0)
 ;;=^^3^3^2911127^^^^
 ;;^DD(53.45,.05,21,1,0)
 ;;=  If this is set to 'YES', this ward clerk/pharmacy technician may actually
 ;;^DD(53.45,.05,21,2,0)
 ;;=cancel patients' Inpatient orders.  If this is set to 'NO' (or not set),
 ;;^DD(53.45,.05,21,3,0)
 ;;=this clerk/technician can only mark orders to be cancelled by another user.
 ;;^DD(53.45,.05,23,0)
 ;;=^^3^3^2911127^^^^
 ;;^DD(53.45,.05,23,1,0)
 ;;=  For ward clerks and pharmacy technicians.  Used by the cancel routines to
 ;;^DD(53.45,.05,23,2,0)
 ;;=determine if the user can cancel orders or only mark the orders to be
 ;;^DD(53.45,.05,23,3,0)
 ;;=canceled later by another user.  Can only be set by a supervisor.
 ;;^DD(53.45,.05,"DT")
 ;;=2920119
 ;;^DD(53.45,.09,0)
 ;;=ALLOW AUTO-VERIFY FOR USER^S^1:YES;0:NO;^0;9^Q
 ;;^DD(53.45,.09,3)
 ;;=Answer 'YES' if verification can be automatic when this user enters orders.
 ;;^DD(53.45,.09,20,0)
 ;;=^.3LA^1^1
 ;;^DD(53.45,.09,20,1,0)
 ;;=PSJ
 ;;^DD(53.45,.09,21,0)
 ;;=^^3^3^2911129^
 ;;^DD(53.45,.09,21,1,0)
 ;;=  This is used to determine if the user can enter Unit Dose orders as
 ;;^DD(53.45,.09,21,2,0)
 ;;=ACTIVE, allowing the user to skip the extra step of manually verifying
 ;;^DD(53.45,.09,21,3,0)
 ;;=those orders entered by this user.
 ;;^DD(53.45,.09,23,0)
 ;;=^^3^3^2911129^
 ;;^DD(53.45,.09,23,1,0)
 ;;=  If this is set to 'YES' for a user that has been designated as a nurse
 ;;^DD(53.45,.09,23,2,0)
 ;;=or pharmacist, orders entered by this user will be transcribed as ACTIVE
 ;;^DD(53.45,.09,23,3,0)
 ;;=(by the routine PSGOETO).  This is editable only by the supervisor.

PSJ4I021
PSJ4I021 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 Q:'DIFQ(53.45)  F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^DD(53.45,.09,"DT")
 ;;=2911129
 ;;^DD(53.45,.12,0)
 ;;=ORDER ENTRY PROCESS^S^0:REGULAR;1:ABBREVIATED;2:WARD;^0;12^Q
 ;;^DD(53.45,.12,.1)
 ;;=
 ;;^DD(53.45,.12,3)
 ;;=Enter the type of Unit Dose order entry to be used by this user.
 ;;^DD(53.45,.12,20,0)
 ;;=^.3LA^1^1
 ;;^DD(53.45,.12,20,1,0)
 ;;=PSJU
 ;;^DD(53.45,.12,21,0)
 ;;=^^15^15^2920323^^^^
 ;;^DD(53.45,.12,21,1,0)
 ;;=  This is the type of order entry process to be used by this user.  The
 ;;^DD(53.45,.12,21,2,0)
 ;;=REGULAR order entry is the full set of prompts for the entry of an order,
 ;;^DD(53.45,.12,21,3,0)
 ;;=after which the user is shown a full view of the order and allowed to take 
 ;;^DD(53.45,.12,21,4,0)
 ;;=immediate action on the order. The ABBREVIATED order entry gives the user 
 ;;^DD(53.45,.12,21,5,0)
 ;;=fewer prompts for the entry of an order, after which the user is shown a 
 ;;^DD(53.45,.12,21,6,0)
 ;;=full view of the order and is allowed to take immediate action on the order.
 ;;^DD(53.45,.12,21,7,0)
 ;;=The WARD order entry gives the user the same prompts as the ABBREVIATED
 ;;^DD(53.45,.12,21,8,0)
 ;;=order entry, but then gives a brief view of the entered order and does
 ;;^DD(53.45,.12,21,9,0)
 ;;=not allow immediate action to be taken on the order.  No entry here is the 
 ;;^DD(53.45,.12,21,10,0)
 ;;=same as selecting REGULAR order entry.
 ;;^DD(53.45,.12,21,11,0)
 ;;= 
 ;;^DD(53.45,.12,21,12,0)
 ;;=  This does not affect the entering of Inpatient Medication orders through
 ;;^DD(53.45,.12,21,13,0)
 ;;=the Order Entry/Results Reporting (OE/RR) package.  This is only for the
 ;;^DD(53.45,.12,21,14,0)
 ;;=entering of Unit Dose orders through the Unit Dose Order Entry option and
 ;;^DD(53.45,.12,21,15,0)
 ;;=the Inpatient Order Entry option.
 ;;^DD(53.45,.12,23,0)
 ;;=^^3^3^2920323^^
 ;;^DD(53.45,.12,23,1,0)
 ;;=  This is used by the Unit Dose order entry functionality to determine the
 ;;^DD(53.45,.12,23,2,0)
 ;;=order entry process to be given each user.  This is referenced in the routines
 ;;^DD(53.45,.12,23,3,0)
 ;;=PSGOE0 and PSJOE0.  This does not affect OE/RR.
 ;;^DD(53.45,.12,"DT")
 ;;=2920125

PSJ4I022
PSJ4I022 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 Q:'DIFQ(57.5)  F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^DIC(57.5,0,"GL")
 ;;=^PS(57.5,
 ;;^DIC("B","WARD GROUP",57.5)
 ;;=
 ;;^DIC(57.5,"%D",0)
 ;;=^^3^3^2910306^^^^
 ;;^DIC(57.5,"%D",1,0)
 ;;=  Allows the user to group the wards from the WARD LOCATION file (42) to
 ;;^DIC(57.5,"%D",2,0)
 ;;=facilitate the printing of reports and for other Unit Dose processes.
 ;;^DIC(57.5,"%D",3,0)
 ;;=Ward groups are required for the running of pick lists.
 ;;^DD(57.5,0)
 ;;=FIELD^^5.07^14
 ;;^DD(57.5,0,"DT")
 ;;=2920128
 ;;^DD(57.5,0,"ID",3)
 ;;=W "   ",@("$P($P($C(59)_$S($D(^DD(57.5,3,0)):$P(^(0),U,3),1:0)_$E("_DIC_"Y,0),0),$C(59)_$P(^(0),U,2)_"":"",2),$C(59),1)")
 ;;^DD(57.5,0,"ID","ATC DEVICE")
 ;;=W:$S($P($G(^PS(57.5,Y,0)),"^",2)="P":$P($G(^(3)),"^")]"",1:0) $P(^(3),"^")
 ;;^DD(57.5,0,"IX","AB",57.51,.01)
 ;;=
 ;;^DD(57.5,0,"IX","AC",57.51,.01)
 ;;=
 ;;^DD(57.5,0,"IX","AP",57.5,3)
 ;;=
 ;;^DD(57.5,0,"IX","ATNC",57.5,.01)
 ;;=
 ;;^DD(57.5,0,"IX","B",57.5,.01)
 ;;=
 ;;^DD(57.5,0,"NM","WARD GROUP")
 ;;=
 ;;^DD(57.5,0,"PT",50.0212,.01)
 ;;=
 ;;^DD(57.5,0,"PT",53.5,.01)
 ;;=
 ;;^DD(57.5,0,"PT",99.9,.01)
 ;;=
 ;;^DD(57.5,.01,0)
 ;;=NAME^RFX^^0;1^K:X[""""!($A(X)=45)!(X=+X) X I $D(X) K:$L(X)>20!($L(X)<1)!'(X'?1P.E)!(X'?.ANP) X
 ;;^DD(57.5,.01,1,0)
 ;;=^.1
 ;;^DD(57.5,.01,1,1,0)
 ;;=57.5^B
 ;;^DD(57.5,.01,1,1,1)
 ;;=S ^PS(57.5,"B",$E(X,1,30),DA)=""
 ;;^DD(57.5,.01,1,1,2)
 ;;=K ^PS(57.5,"B",$E(X,1,30),DA)
 ;;^DD(57.5,.01,1,2,0)
 ;;=57.5^ATNC^MUMPS
 ;;^DD(57.5,.01,1,2,1)
 ;;=I '$D(PSGINITF) S ^PS(57.5,"ATNC")=$S($D(^PS(59.7,1,20)):$P(^(20),"^"),1:"")
 ;;^DD(57.5,.01,1,2,2)
 ;;=Q
 ;;^DD(57.5,.01,1,2,3)
 ;;=Needed by the Inpatient Medications init process.
 ;;^DD(57.5,.01,1,2,"%D",0)
 ;;=^^3^3^2911126^
 ;;^DD(57.5,.01,1,2,"%D",1,0)
 ;;=  This is used by the Inpatient Medications init process.  If the post-init
 ;;^DD(57.5,.01,1,2,"%D",2,0)
 ;;=process does not find this cross reference, it converts this file for use
 ;;^DD(57.5,.01,1,2,"%D",3,0)
 ;;=with the new pick list.  (Routine used is PSGPOST.)
 ;;^DD(57.5,.01,3)
 ;;=Answer must be 1-20 characters in length.
 ;;^DD(57.5,.01,20,0)
 ;;=^.3LA^1^1
 ;;^DD(57.5,.01,20,1,0)
 ;;=PSJU
 ;;^DD(57.5,.01,21,0)
 ;;=^^1^1^2910306^^
 ;;^DD(57.5,.01,21,1,0)
 ;;=  This is a generic name for a grouping of wards.
 ;;^DD(57.5,.01,"DEL",.01,0)
 ;;=I $D(^PS(53.5,"A",DA)) W *7,!!?2,"There is at least one PICK LIST for this WARD GROUP.  This WARD GROUP cannot",!,"be deleted until the PICK LIST(s) is purged or deleted."
 ;;^DD(57.5,.01,"DT")
 ;;=2901115
 ;;^DD(57.5,5.01,0)
 ;;=PICK LIST - ROOM/BED SORT^S^0:ROOM-BED;1:BED-ROOM;^5;1^Q
 ;;^DD(57.5,5.01,.1)
 ;;=Should the pick lists sort orders by ROOM-BED, or by BED-ROOM?
 ;;^DD(57.5,5.01,3)
 ;;=Enter how you want the pick list to sort the room-bed.
 ;;^DD(57.5,5.01,4)
 ;;=W !,"Enter a '1' to have the pick lists sort orders by BED-ROOM."
 ;;^DD(57.5,5.01,20,0)
 ;;=^.3LA^1^1
 ;;^DD(57.5,5.01,20,1,0)
 ;;=PSJU
 ;;^DD(57.5,5.01,21,0)
 ;;=^^5^5^2910306^^^^
 ;;^DD(57.5,5.01,21,1,0)
 ;;=  The Pick List normally sorts patients' orders by ROOM-BED.  To have
 ;;^DD(57.5,5.01,21,2,0)
 ;;=the Pick List sort orders by BED-ROOM, enter a '1' here.  Any change
 ;;^DD(57.5,5.01,21,3,0)
 ;;=in this field will NOT affect Pick Lists already run.  PLEASE NOTE
 ;;^DD(57.5,5.01,21,4,0)
 ;;=that if the pick list is flagged to NOT sort by ROOM-BED, this flag
 ;;^DD(57.5,5.01,21,5,0)
 ;;=will be ignored.

PSJ4I023
PSJ4I023 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 Q:'DIFQ(57.5)  F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^DD(57.5,5.01,"DT")
 ;;=2870204
 ;;^DD(57.5,5.02,0)
 ;;=PICK LIST - OMIT WARD SORT^S^0:NO (SORT BY WARD);1:YES (DO NOT SORT BY WARD);^5;2^Q
 ;;^DD(57.5,5.02,.1)
 ;;=Should the pick lists NOT sort orders by ward?
 ;;^DD(57.5,5.02,3)
 ;;=Answer 'YES' (or '1') to have the pick list NOT sort by ward.
 ;;^DD(57.5,5.02,20,0)
 ;;=^.3LA^1^1
 ;;^DD(57.5,5.02,20,1,0)
 ;;=PSJU
 ;;^DD(57.5,5.02,21,0)
 ;;=^^4^4^2910306^^^^
 ;;^DD(57.5,5.02,21,1,0)
 ;;=  The Pick List normally sorts orders by TEAM, WARD, ROOM-BED...  To
 ;;^DD(57.5,5.02,21,2,0)
 ;;=have the Pick List omit the WARD sort, answer 'YES' here, and the Pick
 ;;^DD(57.5,5.02,21,3,0)
 ;;=List will sort by TEAM, ROOM-BED (and NOT by WARD).  Any change here
 ;;^DD(57.5,5.02,21,4,0)
 ;;=will NOT affect any Pick Lists that have already been run.
 ;;^DD(57.5,5.02,"DT")
 ;;=2900410
 ;;^DD(57.5,5.03,0)
 ;;=PICK LIST - OMIT ROOM-BED SORT^S^1:YES (DO NOT SORT BY ROOM-BED);0:NO (SORT BY ROOM-BED);^5;3^Q
 ;;^DD(57.5,5.03,.1)
 ;;=Should the pick lists NOT sort orders by room-bed?
 ;;^DD(57.5,5.03,3)
 ;;=Answer 'YES' to have the pick list NOT sort by room-bed.
 ;;^DD(57.5,5.03,20,0)
 ;;=^.3LA^1^1
 ;;^DD(57.5,5.03,20,1,0)
 ;;=PSJU
 ;;^DD(57.5,5.03,21,0)
 ;;=^^4^4^2900410^^^^
 ;;^DD(57.5,5.03,21,1,0)
 ;;=  The PICK LIST normally sorts orders by ...TEAM, WARD, ROOM-BED, PATIENT
 ;;^DD(57.5,5.03,21,2,0)
 ;;=NAME...  To have the pick list NOT sort by ROOM-BED at all, answer 'YES'
 ;;^DD(57.5,5.03,21,3,0)
 ;;=here.  Any change here will NOT affect pick lists that have already been
 ;;^DD(57.5,5.03,21,4,0)
 ;;=run.
 ;;^DD(57.5,5.03,"DT")
 ;;=2900410
 ;;^DD(57.5,5.04,0)
 ;;=PICK LIST - FORM FEED/PATIENT^S^0:NO;1:YES;^5;4^Q
 ;;^DD(57.5,5.04,.1)
 ;;=Should the pick lists start a new page for each patient?
 ;;^DD(57.5,5.04,3)
 ;;=Answer 'YES' to have the pick lists printed start a new page for each patient.
 ;;^DD(57.5,5.04,20,0)
 ;;=^.3LA^1^1
 ;;^DD(57.5,5.04,20,1,0)
 ;;=PSJU
 ;;^DD(57.5,5.04,21,0)
 ;;=^^2^2^2910306^^^^
 ;;^DD(57.5,5.04,21,1,0)
 ;;=  This is a flag that tells the package to start a new page for each
 ;;^DD(57.5,5.04,21,2,0)
 ;;=patient found when printing the pick list.
 ;;^DD(57.5,5.04,"DT")
 ;;=2870721
 ;;^DD(57.5,5.05,0)
 ;;=PICK LIST - FORM FEED/WARD^S^1:YES;0:NO;^5;5^Q
 ;;^DD(57.5,5.05,.1)
 ;;=Should the pick lists start a new page for each ward?
 ;;^DD(57.5,5.05,3)
 ;;=Answer 'YES' to have the pick list start a new page for each ward.
 ;;^DD(57.5,5.05,20,0)
 ;;=^.3LA^1^1
 ;;^DD(57.5,5.05,20,1,0)
 ;;=PSJU
 ;;^DD(57.5,5.05,21,0)
 ;;=^^3^3^2910306^^^^
 ;;^DD(57.5,5.05,21,1,0)
 ;;=  This is a flag that tells the pick list to start a new page for each ward
 ;;^DD(57.5,5.05,21,2,0)
 ;;=found when printing.  This flag is ignored if the "NEW PAGE PER PATIENT"
 ;;^DD(57.5,5.05,21,3,0)
 ;;=flag is turned on.
 ;;^DD(57.5,5.05,"DT")
 ;;=2880526
 ;;^DD(57.5,5.06,0)
 ;;=PICK LIST - LINES ON FORM FEED^S^1:YES;0:NO;^5;6^Q
 ;;^DD(57.5,5.06,.1)
 ;;=Should the pick lists print the "FILLED BY" lines after each patient (or ward)?
 ;;^DD(57.5,5.06,3)
 ;;=Answer 'YES' to have the "FILLED BY" lines print after each ward or patient on the pick list.
 ;;^DD(57.5,5.06,20,0)
 ;;=^.3LA^1^1
 ;;^DD(57.5,5.06,20,1,0)
 ;;=PSJU
 ;;^DD(57.5,5.06,21,0)
 ;;=^^4^4^2890927^^
 ;;^DD(57.5,5.06,21,1,0)
 ;;=  This is a flag that tells the pick list to print the "FILLED BY" and the

PSJ4I024
PSJ4I024 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 Q:'DIFQ(57.5)  F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^DD(57.5,5.06,21,2,0)
 ;;="CHECKED BY" lines after each ward or patient.  This is used only if either
 ;;^DD(57.5,5.06,21,3,0)
 ;;=of the "PICK LIST FORM FEED/PATIENT" or "PICK LIST FORM FEED/WARD" site
 ;;^DD(57.5,5.06,21,4,0)
 ;;=parameters is turned on.
 ;;^DD(57.5,5.06,"DT")
 ;;=2880526

PSJ4I025
PSJ4I025 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 Q:'DIFQ(58.1)  F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^DIC(58.1,0,"GL")
 ;;=^PSI(58.1,
 ;;^DIC("B","PHARMACY AOU STOCK",58.1)
 ;;=
 ;;^DIC(58.1,"%",0)
 ;;=^1.005^1^1
 ;;^DIC(58.1,"%",1,0)
 ;;=PSGW
 ;;^DIC(58.1,"%","B","PSGW",1)
 ;;=
 ;;^DIC(58.1,"%D",0)
 ;;=^^3^3^2900320^^^^
 ;;^DIC(58.1,"%D",1,0)
 ;;=This file defines the items, their location, and quantity for each area
 ;;^DIC(58.1,"%D",2,0)
 ;;=of use (AOU) in the hospital.  Additionally, information for each
 ;;^DIC(58.1,"%D",3,0)
 ;;=inventory, by item, is stored for an audit trail of usage.
 ;;^DD(58.1,0)
 ;;=FIELD^^1^2
 ;;^DD(58.1,0,"DT")
 ;;=2920212
 ;;^DD(58.1,0,"ID","WRITE")
 ;;=I $D(^("I")),^("I")]"",^("I")'>DT W "    *** INACTIVE ***" 
 ;;^DD(58.1,0,"IX","B",58.1,.01)
 ;;=
 ;;^DD(58.1,0,"IX","D",58.26,.01)
 ;;=
 ;;^DD(58.1,0,"IX","OND",58.28,.01)
 ;;=
 ;;^DD(58.1,0,"NM","PHARMACY AOU STOCK")
 ;;=
 ;;^DD(58.1,0,"PT",58.21,.01)
 ;;=
 ;;^DD(58.1,0,"PT",58.24,.01)
 ;;=
 ;;^DD(58.1,0,"PT",58.31,.01)
 ;;=
 ;;^DD(58.1,.01,0)
 ;;=AREA OF USE (AOU)^RF^^0;1^K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>30!($L(X)<2) X
 ;;^DD(58.1,.01,1,0)
 ;;=^.1^^-1
 ;;^DD(58.1,.01,1,1,0)
 ;;=58.1^B
 ;;^DD(58.1,.01,1,1,1)
 ;;=S ^PSI(58.1,"B",$E(X,1,30),DA)=""
 ;;^DD(58.1,.01,1,1,2)
 ;;=K ^PSI(58.1,"B",$E(X,1,30),DA)
 ;;^DD(58.1,.01,3)
 ;;=Answer must be 2-30 characters in length
 ;;^DD(58.1,.01,21,0)
 ;;=^^4^4^2890830^^^^
 ;;^DD(58.1,.01,21,1,0)
 ;;=This is the name of the Area Of Use.  The AOU may represent a single
 ;;^DD(58.1,.01,21,2,0)
 ;;=ward or a combination of wards and their percentages of the total use.
 ;;^DD(58.1,.01,21,3,0)
 ;;=Areas of Use may also represent an area of the hospital with no affiliated
 ;;^DD(58.1,.01,21,4,0)
 ;;=wards, i.e. cardiac cath lab or dental clinic.
 ;;^DD(58.1,.01,"DEL",13000,0)
 ;;=I $O(^PSI(58.1,DA,1,0)) W !,"AOUs CANNOT BE DELETED IF THERE ARE ITEMS DEFINED!"
 ;;^DD(58.1,.01,"DT")
 ;;=2890920
 ;;^DD(58.1,1,0)
 ;;=ITEM^58.11IP^^1;0
 ;;^DD(58.1,1,"DT")
 ;;=2920218
 ;;^DD(58.11,0)
 ;;=ITEM SUB-FIELD^NL^.01^1
 ;;^DD(58.11,0,"DT")
 ;;=2920212
 ;;^DD(58.11,0,"IX","B",58.11,.01)
 ;;=
 ;;^DD(58.11,0,"NM","ITEM")
 ;;=
 ;;^DD(58.11,0,"UP")
 ;;=58.1
 ;;^DD(58.11,.01,0)
 ;;=ITEM^MR*P50'^PSDRUG(^0;1^S DIC("S")="D DRGSCRN^PSGWUTL" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X
 ;;^DD(58.11,.01,1,0)
 ;;=^.1
 ;;^DD(58.11,.01,1,1,0)
 ;;=58.11^B
 ;;^DD(58.11,.01,1,1,1)
 ;;=S ^PSI(58.1,DA(1),1,"B",$E(X,1,30),DA)=""
 ;;^DD(58.11,.01,1,1,2)
 ;;=K ^PSI(58.1,DA(1),1,"B",$E(X,1,30),DA)
 ;;^DD(58.11,.01,3)
 ;;=Enter name of drug being stocked in this AOU.
 ;;^DD(58.11,.01,4)
 ;;=
 ;;^DD(58.11,.01,12)
 ;;=Do not select INACTIVE or NON-PHARMACY items.
 ;;^DD(58.11,.01,12.1)
 ;;=S DIC("S")="D DRGSCRN^PSGWUTL"
 ;;^DD(58.11,.01,21,0)
 ;;=^^1^1^2920212^^^^
 ;;^DD(58.11,.01,21,1,0)
 ;;=ITEM defines the name of the drug stocked in this Area of Use.
 ;;^DD(58.11,.01,"DEL",13000,0)
 ;;=I 1 W !,"ITEMS CANNOT BE DELETED,MUST BE INACTIVATED!"
 ;;^DD(58.11,.01,"DT")
 ;;=2920212

PSJ4I026
PSJ4I026 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 Q:'DIFQ(59.5)  F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^DIC(59.5,0,"GL")
 ;;=^PS(59.5,
 ;;^DIC("B","IV ROOM",59.5)
 ;;=
 ;;^DIC(59.5,"%D",0)
 ;;=^^1^1^2881130^^
 ;;^DIC(59.5,"%D",1,0)
 ;;=This file is the location of the IV ROOM site parameters.
 ;;^DD(59.5,0)
 ;;=FIELD^^19^30
 ;;^DD(59.5,0,"DT")
 ;;=2920519
 ;;^DD(59.5,0,"IX","B",59.5,.01)
 ;;=
 ;;^DD(59.5,0,"NM","IV ROOM")
 ;;=
 ;;^DD(59.5,0,"PT",50.8,.01)
 ;;=
 ;;^DD(59.5,0,"PT",53.1,62)
 ;;=
 ;;^DD(59.5,0,"PT",55.01,.22)
 ;;=
 ;;^DD(59.5,.01,0)
 ;;=NAME^RF^^0;1^K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>30!($L(X)<1)!'(X'?1P.E)!(X'?.ANP) X
 ;;^DD(59.5,.01,1,0)
 ;;=^.1
 ;;^DD(59.5,.01,1,1,0)
 ;;=59.5^B
 ;;^DD(59.5,.01,1,1,1)
 ;;=S ^PS(59.5,"B",$E(X,1,30),DA)=""
 ;;^DD(59.5,.01,1,1,2)
 ;;=K ^PS(59.5,"B",$E(X,1,30),DA)
 ;;^DD(59.5,.01,3)
 ;;=Answer must be 1-30 characters in length, identifying an IV distribution area.  Each satellite (area) must be named separately.
 ;;^DD(59.5,.01,20,0)
 ;;=^.3LA^1^1
 ;;^DD(59.5,.01,20,1,0)
 ;;=PSJI
 ;;^DD(59.5,.01,21,0)
 ;;=^^2^2^2920518^^^^
 ;;^DD(59.5,.01,21,1,0)
 ;;=Each IV order belongs to the IV room that input the order.  An IV room
 ;;^DD(59.5,.01,21,2,0)
 ;;=may process ONLY those orders that belong to that IV room.
 ;;^DD(59.5,.01,"DEL",1,0)
 ;;=I 1 W *7,!,"IV ROOMS CANNOT BE DELETED!!"
 ;;^DD(59.5,.01,"DT")
 ;;=2860730

PSJ4I027
PSJ4I027 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 Q:'DIFQ(59.6)  F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^DIC(59.6,0,"GL")
 ;;=^PS(59.6,
 ;;^DIC("B","INPATIENT WARD PARAMETERS",59.6)
 ;;=
 ;;^DD(59.6,0)
 ;;=FIELD^^.05^15
 ;;^DD(59.6,0,"DT")
 ;;=2920429
 ;;^DD(59.6,0,"IX","AC",59.6,.08)
 ;;=
 ;;^DD(59.6,0,"IX","B",59.6,.01)
 ;;=
 ;;^DD(59.6,0,"NM","INPATIENT WARD PARAMETERS")
 ;;=
 ;;^DD(59.6,0,"PT",53.4104,1)
 ;;=
 ;;^DD(59.6,0,"PT",59.7,20.6)
 ;;=
 ;;^DD(59.6,.01,0)
 ;;=WARD^RP42'^DIC(42,^0;1^Q
 ;;^DD(59.6,.01,1,0)
 ;;=^.1
 ;;^DD(59.6,.01,1,1,0)
 ;;=59.6^B
 ;;^DD(59.6,.01,1,1,1)
 ;;=S ^PS(59.6,"B",$E(X,1,30),DA)=""
 ;;^DD(59.6,.01,1,1,2)
 ;;=K ^PS(59.6,"B",$E(X,1,30),DA)
 ;;^DD(59.6,.01,3)
 ;;=Enter a ward for which you want to tailor the Inpatient Medication package.
 ;;^DD(59.6,.01,20,0)
 ;;=^.3LA^1^1
 ;;^DD(59.6,.01,20,1,0)
 ;;=PSJ
 ;;^DD(59.6,.01,21,0)
 ;;=^^2^2^2910701^
 ;;^DD(59.6,.01,21,1,0)
 ;;=  This is a ward for which the site wants to tailor specific aspects of
 ;;^DD(59.6,.01,21,2,0)
 ;;=the Inpatient Medications package.
 ;;^DD(59.6,.01,"DT")
 ;;=2910730
 ;;^DD(59.6,.01,"LAYGO",1,0)
 ;;=S X(1)=$D(^PS(59.6,"B",$E(X,1,30))) S:X(1) X(2)=$P($G(^DIC(42,+X,0)),"^") S:$S(X(1):X(2)="",1:0) X(2)=X W:X(1) !?3,"But an entry for ",X(2)," already exists!" I 'X(1)
 ;;^DD(59.6,.03,0)
 ;;=DAYS UNTIL STOP DATE/TIME^NJ3,0^^0;3^K:+X'=X!(X>100)!(X<1)!(X?.E1"."1N.N) X
 ;;^DD(59.6,.03,.1)
 ;;=How many days should a standard order last?
 ;;^DD(59.6,.03,3)
 ;;=Enter the number (1-100) of days that an order will last.
 ;;^DD(59.6,.03,20,0)
 ;;=^.3LA^1^1
 ;;^DD(59.6,.03,20,1,0)
 ;;=PSJU
 ;;^DD(59.6,.03,21,0)
 ;;=^^4^4^2910311^^^^
 ;;^DD(59.6,.03,21,1,0)
 ;;=  This is the number of days a standard order should last.  The first order
 ;;^DD(59.6,.03,21,2,0)
 ;;=entered for a patient uses this number to calculate a default value for
 ;;^DD(59.6,.03,21,3,0)
 ;;=the order's STOP DATE/TIME.  This number is also used if SAME STOP DATE
 ;;^DD(59.6,.03,21,4,0)
 ;;=has no entry, or an entry of "NO".
 ;;^DD(59.6,.03,"DT")
 ;;=2850618
 ;;^DD(59.6,.04,0)
 ;;=SAME STOP DATE ON ALL ORDERS^S^1:YES;0:NO;^0;4^Q
 ;;^DD(59.6,.04,.1)
 ;;=Should all of a patient's orders be given the same stop date?
 ;;^DD(59.6,.04,3)
 ;;=Answer 'YES' (or '1') if all of a patient's orders are to stop on the same date/time.
 ;;^DD(59.6,.04,20,0)
 ;;=^.3LA^1^1
 ;;^DD(59.6,.04,20,1,0)
 ;;=PSJU
 ;;^DD(59.6,.04,21,0)
 ;;=^^3^3^2911108^^^^
 ;;^DD(59.6,.04,21,1,0)
 ;;=  This is a flag, that if found to be YES, uses the STOP DATE/TIME from 
 ;;^DD(59.6,.04,21,2,0)
 ;;=the patient's first order as a default value for the STOP DATE/TIME of 
 ;;^DD(59.6,.04,21,3,0)
 ;;=all of the patient's following orders.
 ;;^DD(59.6,.04,"DT")
 ;;=2850618
 ;;^DD(59.6,.05,0)
 ;;=USE NEXT ADMIN TIME ONLY^S^1:YES;0:NO;^0;5^Q
 ;;^DD(59.6,.05,.1)
 ;;=USE NEXT ADMIN TIME ONLY FOR START DATE/TIME DEFAULT
 ;;^DD(59.6,.05,3)
 ;;=Enter 'YES' to have the default start date/time use the next admin time of the order only during order entry.
 ;;^DD(59.6,.05,20,0)
 ;;=^.3LA^1^1
 ;;^DD(59.6,.05,20,1,0)
 ;;=PSJ
 ;;^DD(59.6,.05,21,0)
 ;;=^^4^4^2920429^
 ;;^DD(59.6,.05,21,1,0)
 ;;=  Whenever a default value for a start date/time is calculated the closest
 ;;^DD(59.6,.05,21,2,0)
 ;;=admin time (or hour), forward or backward.  This allows the ward to tell
 ;;^DD(59.6,.05,21,3,0)
 ;;=the package to only use the closest admin time (or hour) forward (in the
 ;;^DD(59.6,.05,21,4,0)
 ;;=future).

PSJ4I028
PSJ4I028 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 Q:'DIFQ(59.6)  F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^DD(59.6,.05,"DT")
 ;;=2920429
 ;;^DD(59.6,.07,0)
 ;;=TIME OF DAY THAT ORDERS STOP^NJ4,0X^^0;7^K:X'?4N!(X>2400)!(X<1)!(X#100>59) X
 ;;^DD(59.6,.07,.1)
 ;;=Time of day that orders stop
 ;;^DD(59.6,.07,3)
 ;;=Enter the time of day that orders stop at this site (military time).
 ;;^DD(59.6,.07,4)
 ;;=W !!,"ENTER A NUMBER BETWEEN 0001 AND 2400.  THE ZEROS ARE NEEDED."
 ;;^DD(59.6,.07,20,0)
 ;;=^.3LA^1^1
 ;;^DD(59.6,.07,20,1,0)
 ;;=PSJU
 ;;^DD(59.6,.07,21,0)
 ;;=^^2^2^2911108^^^^
 ;;^DD(59.6,.07,21,1,0)
 ;;=  This is a time of day that, if found, will be used in calculating the
 ;;^DD(59.6,.07,21,2,0)
 ;;=default value for the STOP DATE/TIME of patients' orders.
 ;;^DD(59.6,.07,"DT")
 ;;=2861130
 ;;^DD(59.6,.08,0)
 ;;=START TIME FOR 24 HOUR MAR^NJ4,0X^^0;8^K:X>2400!(X<1)!(X'?4N)!(X#100>59) X
 ;;^DD(59.6,.08,.1)
 ;;=Start time of day for 24 hour MAR
 ;;^DD(59.6,.08,1,0)
 ;;=^.1
 ;;^DD(59.6,.08,1,1,0)
 ;;=59.6^AC^MUMPS
 ;;^DD(59.6,.08,1,1,1)
 ;;=S Y=X-1 S:'Y Y=2400 S Y=$E("000",1,4-$L(Y))_Y S:$E(Y,3)=9 Y=$E(Y,1,2)_"59" S $P(^PS(59.6,DA,0),"^",9)=Y
 ;;^DD(59.6,.08,1,1,2)
 ;;=S $P(^PS(59.6,DA,0),"^",9)=""
 ;;^DD(59.6,.08,1,1,3)
 ;;=Used by the Unit Dose Medications package.
 ;;^DD(59.6,.08,1,1,"%D",0)
 ;;=^^1^1^2911126^
 ;;^DD(59.6,.08,1,1,"%D",1,0)
 ;;=  This is used to automatically update the STOP TIME FOR MAR field (.09).
 ;;^DD(59.6,.08,3)
 ;;=Enter the time of day (0001-2400) that the 24 MAR is to start.
 ;;^DD(59.6,.08,4)
 ;;=W !,"PLEASE USE MILITARY TIME WITH LEADING AND TRAILING ZEROS."
 ;;^DD(59.6,.08,20,0)
 ;;=^.3LA^1^1
 ;;^DD(59.6,.08,20,1,0)
 ;;=PSJU
 ;;^DD(59.6,.08,21,0)
 ;;=^^4^4^2911108^^^^
 ;;^DD(59.6,.08,21,1,0)
 ;;=  This is the start time for the 24 hour MAR.  It is used whenever a user
 ;;^DD(59.6,.08,21,2,0)
 ;;=enters a start date without a time when running the 24 hour MAR.  This time
 ;;^DD(59.6,.08,21,3,0)
 ;;=should be in military time format, with leading and trailing zeros.
 ;;^DD(59.6,.08,21,4,0)
 ;;=(Entering '0001' would be seen as 1 minute after midnight.)
 ;;^DD(59.6,.08,"DT")
 ;;=2850906
 ;;^DD(59.6,.09,0)
 ;;=STOP TIME FOR MAR^NJ4,0^^0;9^K:+X'=X!(X>2400)!(X<1)!(X?.E1"."1N.N) X
 ;;^DD(59.6,.09,3)
 ;;=
 ;;^DD(59.6,.09,4)
 ;;=W !,"THIS FIELD IS NOT TO BE CHANGED!!"
 ;;^DD(59.6,.09,9)
 ;;=^
 ;;^DD(59.6,.09,20,0)
 ;;=^.3LA^1^1
 ;;^DD(59.6,.09,20,1,0)
 ;;=PSJU
 ;;^DD(59.6,.09,21,0)
 ;;=^^2^2^2910306^^^^
 ;;^DD(59.6,.09,21,1,0)
 ;;=  This is the stop time for the 24 hour MAR.  It is automatically calculated
 ;;^DD(59.6,.09,21,2,0)
 ;;=when the START TIME FOR MAR is entered.
 ;;^DD(59.6,.09,"DT")
 ;;=2850906
 ;;^DD(59.6,.11,0)
 ;;=DAYS NEW LABELS LAST^NJ2,0^^0;11^K:+X'=X!(X>35)!(X<0)!(X?.E1"."1N.N) X
 ;;^DD(59.6,.11,.1)
 ;;=How many days should new labels last?
 ;;^DD(59.6,.11,3)
 ;;=Enter a whole number between 0 and 35.
 ;;^DD(59.6,.11,4)
 ;;=W !,"ANY NEW LABELS OLDER THAN THE NUMBER OF DAYS SPECIFIED HERE WILL AUTOMATICALLY  BE PURGED."
 ;;^DD(59.6,.11,5,1,0)
 ;;=59.4^10^1
 ;;^DD(59.6,.11,20,0)
 ;;=^.3LA^1^1
 ;;^DD(59.6,.11,20,1,0)
 ;;=PSJU
 ;;^DD(59.6,.11,21,0)
 ;;=^^6^6^2910306^^^^
 ;;^DD(59.6,.11,21,1,0)
 ;;=  The Unit Dose package will run a background job once a day that will
 ;;^DD(59.6,.11,21,2,0)
 ;;=delete all unprinted new labels older than the number of days specified
 ;;^DD(59.6,.11,21,3,0)
 ;;=here.  If no days are specified here, any unprinted new labels for this 

PSJ4I029
PSJ4I029 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 Q:'DIFQ(59.6)  F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^DD(59.6,.11,21,4,0)
 ;;=site will be purged at the end of the day.
 ;;^DD(59.6,.11,21,5,0)
 ;;=  **PLEASE NOTE - A label can still be printed for an order even though
 ;;^DD(59.6,.11,21,6,0)
 ;;=its new label record has been purged.
 ;;^DD(59.6,.11,"DT")
 ;;=2860225
 ;;^DD(59.6,.12,0)
 ;;=LABEL FOR WARD STAFF^S^0:NO LABELS;1:FIRST LABEL ON ORDER ENTRY/EDIT;2:LABEL ON ENTRY/EDIT AND VERIFICATION;3:FIRST LABEL ON NURSE VERIFICATION;^0;12^Q
 ;;^DD(59.6,.12,.1)
 ;;=When should the first label print for ward staff?
 ;;^DD(59.6,.12,5,1,0)
 ;;=59.4^10^2
 ;;^DD(59.6,.12,20,0)
 ;;=^.3LA^1^1
 ;;^DD(59.6,.12,20,1,0)
 ;;=PSJU
 ;;^DD(59.6,.12,21,0)
 ;;=^^13^13^2910727^^^^
 ;;^DD(59.6,.12,21,1,0)
 ;;=  Select from one of the following:
 ;;^DD(59.6,.12,21,2,0)
 ;;=NO LABELS - Labels will not be created when ward staff (nurses, clerks,
 ;;^DD(59.6,.12,21,3,0)
 ;;=physicians, etc.) take an action on an order.
 ;;^DD(59.6,.12,21,4,0)
 ;;=FIRST LABEL ON ORDER ENTRY/EDIT - Labels will be created whenever ward
 ;;^DD(59.6,.12,21,5,0)
 ;;=staff enter an order or edit a non-verified order, but not when the nurse
 ;;^DD(59.6,.12,21,6,0)
 ;;=verifies the order.
 ;;^DD(59.6,.12,21,7,0)
 ;;=FIRST LABEL ON NURSE VERIFICATION - Labels will not be created for ward
 ;;^DD(59.6,.12,21,8,0)
 ;;=staff until a nurse has verified the order.
 ;;^DD(59.6,.12,21,9,0)
 ;;=LABEL ON ENTRY/EDIT AND VERIFICATION - Labels are created whenever the
 ;;^DD(59.6,.12,21,10,0)
 ;;=order is entered, edited, and verified.
 ;;^DD(59.6,.12,21,11,0)
 ;;= 
 ;;^DD(59.6,.12,21,12,0)
 ;;=  Labels are always created for actions taken on orders after they are
 ;;^DD(59.6,.12,21,13,0)
 ;;=verified, unless NO LABELS is selected.
 ;;^DD(59.6,.12,23,0)
 ;;=^^3^3^2910727^
 ;;^DD(59.6,.12,23,1,0)
 ;;=  This is used by the order entry, edit, and verify routines to determine
 ;;^DD(59.6,.12,23,2,0)
 ;;=if a label should be created for the order whenever these action take
 ;;^DD(59.6,.12,23,3,0)
 ;;=place on the order by ward staff personnel.
 ;;^DD(59.6,.12,"DT")
 ;;=2910727
 ;;^DD(59.6,.13,0)
 ;;=WARD LABEL PRINTER^FX^^0;13^D ENDL^PSJPRE42
 ;;^DD(59.6,.13,3)
 ;;=Enter the device to which labels created by ward staff will be printed.
 ;;^DD(59.6,.13,4)
 ;;=D ENDH^PSJPRE42(DZ)
 ;;^DD(59.6,.13,20,0)
 ;;=^.3LA^1^1
 ;;^DD(59.6,.13,20,1,0)
 ;;=PSJU
 ;;^DD(59.6,.13,21,0)
 ;;=^^2^2^2910730^^
 ;;^DD(59.6,.13,21,1,0)
 ;;=  If a device is entered here, labels created by ward staff due to actions
 ;;^DD(59.6,.13,21,2,0)
 ;;=taken on orders will print automatically to the device entered.
 ;;^DD(59.6,.13,23,0)
 ;;=^^3^3^2910730^
 ;;^DD(59.6,.13,23,1,0)
 ;;=  This is used to automatically print labels on the ward whenever ward
 ;;^DD(59.6,.13,23,2,0)
 ;;=staff create labels due to their actions on orders.  The input transform
 ;;^DD(59.6,.13,23,3,0)
 ;;=call to ENDLP^PSGSET makes a call to %ZIS to get ION (the device name).
 ;;^DD(59.6,.13,"DT")
 ;;=2920218
 ;;^DD(59.6,.14,0)
 ;;=PHARMACY LABEL PRINTER^FX^^0;14^D ENDL^PSJPRE42
 ;;^DD(59.6,.14,3)
 ;;=Enter the device to which labels created by pharmacy staff will be printed.
 ;;^DD(59.6,.14,4)
 ;;=D ENDH^PSJPRE42(DZ)
 ;;^DD(59.6,.14,20,0)
 ;;=^.3LA^1^1
 ;;^DD(59.6,.14,20,1,0)
 ;;=PSJU
 ;;^DD(59.6,.14,21,0)
 ;;=^^2^2^2910730^^^
 ;;^DD(59.6,.14,21,1,0)
 ;;=  If a device is entered here, labels created by pharmacy staff due to

PSJ4I030
PSJ4I030 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 Q:'DIFQ(59.6)  F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^DD(59.6,.14,21,2,0)
 ;;=actions taken on orders will print automatically to the device entered.
 ;;^DD(59.6,.14,23,0)
 ;;=^^4^4^2910730^^
 ;;^DD(59.6,.14,23,1,0)
 ;;=  This is used to automatically print labels in the pharmacy whenever
 ;;^DD(59.6,.14,23,2,0)
 ;;=pharmacy staff create labels due to their actions on orders.  The input
 ;;^DD(59.6,.14,23,3,0)
 ;;=transform call to ENDLP^PSGSET makes a call to %ZIS to get ION (the device
 ;;^DD(59.6,.14,23,4,0)
 ;;=name).
 ;;^DD(59.6,.14,"DT")
 ;;=2920218
 ;;^DD(59.6,.15,0)
 ;;=LABEL ON AUTO-CANCEL^S^1:YES;0:NO;^0;15^Q
 ;;^DD(59.6,.15,3)
 ;;=Answer 'YES' to have labels created when this ward's patients' orders are auto-cancelled.
 ;;^DD(59.6,.15,20,0)
 ;;=^.3LA^1^1
 ;;^DD(59.6,.15,20,1,0)
 ;;=PSJ
 ;;^DD(59.6,.15,21,0)
 ;;=^^3^3^2920110^^
 ;;^DD(59.6,.15,21,1,0)
 ;;=  This is used to determine if labels should be created when orders for
 ;;^DD(59.6,.15,21,2,0)
 ;;=a patient from this ward are auto-cancelled due a patient movement. Patient
 ;;^DD(59.6,.15,21,3,0)
 ;;=movements include discharges and transfers.
 ;;^DD(59.6,.15,23,0)
 ;;=^^3^3^2911129^
 ;;^DD(59.6,.15,23,1,0)
 ;;=  Used by the auto-cancel routines (PSJADT*) to determine if labels should
 ;;^DD(59.6,.15,23,2,0)
 ;;=be created for orders that are auto-cancelled due to patient movements from
 ;;^DD(59.6,.15,23,3,0)
 ;;=this ward.
 ;;^DD(59.6,.15,"DT")
 ;;=2911129
 ;;^DD(59.6,.16,0)
 ;;=LABEL FOR PHARMACY^S^0:NO LABELS;1:FIRST LABEL ON ORDER ENTRY/EDIT;2:LABEL ON ENTRY/EDIT AND VERIFICATION;3:FIRST LABEL ON PHARMACIST VERIFICATION;^0;16^Q
 ;;^DD(59.6,.16,.1)
 ;;=When should the first label print for pharmacists?
 ;;^DD(59.6,.16,20,0)
 ;;=^.3LA^1^1
 ;;^DD(59.6,.16,20,1,0)
 ;;=PSJU
 ;;^DD(59.6,.16,21,0)
 ;;=^^13^13^2920110^^^^
 ;;^DD(59.6,.16,21,1,0)
 ;;=  Select from the following:
 ;;^DD(59.6,.16,21,2,0)
 ;;=NO LABELS - Labels will not be created when pharmacy staff (pharmacists
 ;;^DD(59.6,.16,21,3,0)
 ;;=and pharmacy technicians) take an action on an order.
 ;;^DD(59.6,.16,21,4,0)
 ;;=FIRST LABEL ON ORDER ENTRY/EDIT - Labels will be created whenever pharmacy
 ;;^DD(59.6,.16,21,5,0)
 ;;=staff enter an order or edit a non-verified order, but not when the
 ;;^DD(59.6,.16,21,6,0)
 ;;=pharmacist verifies the order.
 ;;^DD(59.6,.16,21,7,0)
 ;;=FIRST LABEL ON VERIFICATION - Labels will not be created for pharmacy staff
 ;;^DD(59.6,.16,21,8,0)
 ;;=until a pharmacist has verified the order.
 ;;^DD(59.6,.16,21,9,0)
 ;;=LABEL ON ENTRY/EDIT AND VERIFICATION - Labels are created whenever the
 ;;^DD(59.6,.16,21,10,0)
 ;;=order is entered, edited, and verified.
 ;;^DD(59.6,.16,21,11,0)
 ;;= 
 ;;^DD(59.6,.16,21,12,0)
 ;;=  Labels are always created for actions taken on orders after they are
 ;;^DD(59.6,.16,21,13,0)
 ;;=verified, unless NO LABELS is selected.
 ;;^DD(59.6,.16,23,0)
 ;;=^^2^2^2911017^^
 ;;^DD(59.6,.16,23,1,0)
 ;;=  This is used to determine if a label should be created whenever an action
 ;;^DD(59.6,.16,23,2,0)
 ;;=has taken place on an order by pharmacy personnel.
 ;;^DD(59.6,.16,"DT")
 ;;=2910727
 ;;^DD(59.6,.24,0)
 ;;='SELF MED' IN ORDER ENTRY^S^1:YES;0:NO;^0;24^Q
 ;;^DD(59.6,.24,.1)
 ;;=Should the 'SELF MED' prompts be included in order entry?
 ;;^DD(59.6,.24,3)
 ;;=Answer 'YES' to have the prompts for patient self-medication included in the order entry process.

PSJ4I031
PSJ4I031 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 Q:'DIFQ(59.6)  F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^DD(59.6,.24,20,0)
 ;;=^.3LA^1^1
 ;;^DD(59.6,.24,20,1,0)
 ;;=PSJU
 ;;^DD(59.6,.24,21,0)
 ;;=^^4^4^2910306^^^^
 ;;^DD(59.6,.24,21,1,0)
 ;;=  If `YES' (or a 1) is entered here, the regular order entry process will
 ;;^DD(59.6,.24,21,2,0)
 ;;=prompt the user for SELF MED and HOSPITAL SUPPLIED SELF MED for each order
 ;;^DD(59.6,.24,21,3,0)
 ;;=entered.  The abbreviated processes and ward order entry and order sets are
 ;;^DD(59.6,.24,21,4,0)
 ;;=not affected in any way by this site parameter.
 ;;^DD(59.6,.24,"DT")
 ;;=2870821
 ;;^DD(59.6,.27,0)
 ;;=PRE-EXCHANGE ENVELOPES^S^1:YES;0:NO;^0;27^Q
 ;;^DD(59.6,.27,.1)
 ;;=Are you using pre-exchange envelopes?
 ;;^DD(59.6,.27,3)
 ;;=Answer 'YES' to have the package print the Pre-Exchange information using the envelope format instead of the regular report format.
 ;;^DD(59.6,.27,20,0)
 ;;=^.3LA^1^1
 ;;^DD(59.6,.27,20,1,0)
 ;;=PSJU
 ;;^DD(59.6,.27,21,0)
 ;;=^^5^5^2910306^^^
 ;;^DD(59.6,.27,21,1,0)
 ;;=  This is a flag that tells the package that the pharmacy is using
 ;;^DD(59.6,.27,21,2,0)
 ;;=special envelopes for their pre-exchange needs report, and will print
 ;;^DD(59.6,.27,21,3,0)
 ;;=the pre-exchange needs information accordingly.  PLEASE NOTE that the
 ;;^DD(59.6,.27,21,4,0)
 ;;=package expects the envelopes to be at least 4 inches long and at least
 ;;^DD(59.6,.27,21,5,0)
 ;;=8 1/2 inches wide.
 ;;^DD(59.6,.27,"DT")
 ;;=2880525

PSJ4I032
PSJ4I032 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 Q:'DIFQ(59.7)  F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^DIC(59.7,0,"GL")
 ;;=^PS(59.7,
 ;;^DIC("B","PHARMACY SYSTEM",59.7)
 ;;=
 ;;^DIC(59.7,"%",0)
 ;;=^1.005^1^1
 ;;^DIC(59.7,"%",1,0)
 ;;=PS
 ;;^DIC(59.7,"%","B","PS",1)
 ;;=
 ;;^DIC(59.7,"%D",0)
 ;;=^^17^17^2911008^^^^
 ;;^DIC(59.7,"%D",1,0)
 ;;=  This file contains data that pertains to the entire Pharmacy system of
 ;;^DIC(59.7,"%D",2,0)
 ;;=a medical center, and not to any one site or division.  The number ranges
 ;;^DIC(59.7,"%D",3,0)
 ;;=for the nodes and field numbers are as follows:
 ;;^DIC(59.7,"%D",4,0)
 ;;=   0 -  9.99  RESERVED
 ;;^DIC(59.7,"%D",5,0)
 ;;=  10 - 19.99  National Drug File
 ;;^DIC(59.7,"%D",6,0)
 ;;=  20 - 29.99  Inpatient
 ;;^DIC(59.7,"%D",7,0)
 ;;=  30 - 39.99  IV's
 ;;^DIC(59.7,"%D",8,0)
 ;;=  40 - 49.99  Outpatient
 ;;^DIC(59.7,"%D",9,0)
 ;;=  50 - 59.99  Ward Stock/AR
 ;;^DIC(59.7,"%D",10,0)
 ;;=  60 - 69.99  Unit Dose
 ;;^DIC(59.7,"%D",11,0)
 ;;= 
 ;;^DIC(59.7,"%D",12,0)
 ;;=  THERE SHOULD ONLY BE ONE ENTRY IN THIS FILE.
 ;;^DIC(59.7,"%D",13,0)
 ;;= 
 ;;^DIC(59.7,"%D",14,0)
 ;;=                           *** NOTE ***
 ;;^DIC(59.7,"%D",15,0)
 ;;=  Because of the nature of this file and the fact that ALL the Pharmacy
 ;;^DIC(59.7,"%D",16,0)
 ;;=packages use this file, it is VERY IMPORTANT to stress that sites DO NOT
 ;;^DIC(59.7,"%D",17,0)
 ;;=edit fields or make local field additions to the Pharmacy System file.
 ;;^DD(59.7,0)
 ;;=FIELD^^31^41
 ;;^DD(59.7,0,"DT")
 ;;=2920511
 ;;^DD(59.7,0,"IX","B",59.7,.01)
 ;;=
 ;;^DD(59.7,0,"NM","PHARMACY SYSTEM")
 ;;=
 ;;^DD(59.7,.01,0)
 ;;=SITE NAME^RF^^0;1^K:$L(X)>40!($L(X)<1) X S:$D(X) DINUM=1
 ;;^DD(59.7,.01,1,0)
 ;;=^.1
 ;;^DD(59.7,.01,1,1,0)
 ;;=59.7^B
 ;;^DD(59.7,.01,1,1,1)
 ;;=S ^PS(59.7,"B",$E(X,1,30),DA)=""
 ;;^DD(59.7,.01,1,1,2)
 ;;=K ^PS(59.7,"B",$E(X,1,30),DA)
 ;;^DD(59.7,.01,3)
 ;;=Answer must be 1-40 characters in length
 ;;^DD(59.7,.01,8.5)
 ;;=^
 ;;^DD(59.7,.01,9)
 ;;=^
 ;;^DD(59.7,.01,20,0)
 ;;=^.3LA^1^1
 ;;^DD(59.7,.01,20,1,0)
 ;;=PS
 ;;^DD(59.7,.01,21,0)
 ;;=^^1^1^2891031^^^^
 ;;^DD(59.7,.01,21,1,0)
 ;;=  This is the name of the site using the Pharmacy package.
 ;;^DD(59.7,.01,"DT")
 ;;=2890728
 ;;^DD(59.7,20.12,0)
 ;;=PRIMARY DRUG CONVERSION DATE^D^^20;12^S %DT="ESTXR" D ^%DT S X=Y K:Y<1 X
 ;;^DD(59.7,20.12,8.5)
 ;;=^
 ;;^DD(59.7,20.12,9)
 ;;=^
 ;;^DD(59.7,20.12,20,0)
 ;;=^.3LA^1^1
 ;;^DD(59.7,20.12,20,1,0)
 ;;=PSJ
 ;;^DD(59.7,20.12,21,0)
 ;;=^^2^2^2920108^
 ;;^DD(59.7,20.12,21,1,0)
 ;;=  This is the date the Primary Drug manual create process was completed.
 ;;^DD(59.7,20.12,21,2,0)
 ;;=This should not be set through VA FileMan.
 ;;^DD(59.7,20.12,23,0)
 ;;=^^5^5^2920108^
 ;;^DD(59.7,20.12,23,1,0)
 ;;=  This is the date the Primary Drug manual create process was completed.
 ;;^DD(59.7,20.12,23,2,0)
 ;;=This is automatically set once a user has completed the process, and should
 ;;^DD(59.7,20.12,23,3,0)
 ;;=not be edited through the VA FileMan.  The version 4 Inpatient Medications
 ;;^DD(59.7,20.12,23,4,0)
 ;;=inits cannot be run until the manual create process has been completed and
 ;;^DD(59.7,20.12,23,5,0)
 ;;=this date has been set.
 ;;^DD(59.7,20.12,"DT")
 ;;=2920108
 ;;^DD(59.7,20.13,0)
 ;;=DATE V4 PRE-PACKET INSTALLED^D^^20;13^S %DT="ESTXR" D ^%DT S X=Y K:Y<1 X
 ;;^DD(59.7,20.13,8.5)
 ;;=^
 ;;^DD(59.7,20.13,9)
 ;;=^
 ;;^DD(59.7,20.13,20,0)
 ;;=^.3LA^1^1
 ;;^DD(59.7,20.13,20,1,0)
 ;;=PSJ
 ;;^DD(59.7,20.13,21,0)
 ;;=^^2^2^2910730^^

PSJ4I033
PSJ4I033 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 Q:'DIFQ(59.7)  F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^DD(59.7,20.13,21,1,0)
 ;;=  This is the date and time the Inpatient Medications version 4 pre-release
 ;;^DD(59.7,20.13,21,2,0)
 ;;=packet was installed at this site.
 ;;^DD(59.7,20.13,23,0)
 ;;=^^5^5^2910730^^
 ;;^DD(59.7,20.13,23,1,0)
 ;;=  Inpatient Medications version 4 will not install unless the pre-release
 ;;^DD(59.7,20.13,23,2,0)
 ;;=packet has already been installed.  When the pre-release packet is
 ;;^DD(59.7,20.13,23,3,0)
 ;;=installed, it enters the date and time it was installed here.  The version
 ;;^DD(59.7,20.13,23,4,0)
 ;;=4 installation will check here to see if the pre-release packet has been
 ;;^DD(59.7,20.13,23,5,0)
 ;;=installed.
 ;;^DD(59.7,20.13,"DT")
 ;;=2910730

PSJ4I034
PSJ4I034 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^UTILITY(U,$J,"DIE",246,0)
 ;;=PSJ4 EUP^2920323.1904^^53.45^^^^
 ;;^UTILITY(U,$J,"DIE",246,"DR",1,53.45)
 ;;=S PSJ=+$G(^PS(53.45,DA,0)) S:PSJ PSJ=$S($D(^XUSEC("PSJ RPHARM",PSJ)):3,$D(^XUSEC("PSJ RNURSE",PSJ)):1,$D(^XUSEC("PSJ PHARM TECH",PSJ)):2,1:0) S:"13"[PSJ Y=$S(PSJ=1:.02,1:.09);.03;.04;.05;.02;S:"02"[PSJ Y=.12;.09;.12;
 ;;^UTILITY(U,$J,"OPT",1550,0)
 ;;=PSJ4 ADDITIVE TYPE^Edit IV Additive Type^^R^^^^^^^^INPATIENT MEDS V4 PRE-RELEASE
 ;;^UTILITY(U,$J,"OPT",1550,1,0)
 ;;=^^8^8^2910925^^^
 ;;^UTILITY(U,$J,"OPT",1550,1,1,0)
 ;;= Allows editing of the TYPE field of the IV ADDITIVE FILE (52.6), which 
 ;;^UTILITY(U,$J,"OPT",1550,1,2,0)
 ;;=marks an additive as an electrolyte or multivitamin. Only additives 
 ;;^UTILITY(U,$J,"OPT",1550,1,3,0)
 ;;=identified as electrolytes or multivitamins will be selectable when 
 ;;^UTILITY(U,$J,"OPT",1550,1,4,0)
 ;;=entering IV Fluid orders through the OE/RR package.
 ;;^UTILITY(U,$J,"OPT",1550,1,5,0)
 ;;= 
 ;;^UTILITY(U,$J,"OPT",1550,1,6,0)
 ;;= This option is part of a pre-release of Inpatient Medications 4.0,
 ;;^UTILITY(U,$J,"OPT",1550,1,7,0)
 ;;=and is included to allow pharmacy to enter this information prior to
 ;;^UTILITY(U,$J,"OPT",1550,1,8,0)
 ;;=the release of the complete package.
 ;;^UTILITY(U,$J,"OPT",1550,20)
 ;;=
 ;;^UTILITY(U,$J,"OPT",1550,25)
 ;;=PSJPRE41
 ;;^UTILITY(U,$J,"OPT",1550,"U")
 ;;=EDIT IV ADDITIVE TYPE
 ;;^UTILITY(U,$J,"OPT",1551,0)
 ;;=PSJ4 IS PRINT^Inpatient Site Print^^R^^^^^^^^INPATIENT MEDS V4 PRE-RELEASE
 ;;^UTILITY(U,$J,"OPT",1551,1,0)
 ;;=^^4^4^2910725^
 ;;^UTILITY(U,$J,"OPT",1551,1,1,0)
 ;;=  This allows users to list the data within the Inpatient Site file to
 ;;^UTILITY(U,$J,"OPT",1551,1,2,0)
 ;;=assist the users in their selection of Inpatient sites when moving the
 ;;^UTILITY(U,$J,"OPT",1551,1,3,0)
 ;;=Inpatient site data to the Inpatient Ward Parameter and Ward Group
 ;;^UTILITY(U,$J,"OPT",1551,1,4,0)
 ;;=files.  Only those fields that are actually moved are shown.
 ;;^UTILITY(U,$J,"OPT",1551,25)
 ;;=PSJPRE44
 ;;^UTILITY(U,$J,"OPT",1551,"U")
 ;;=INPATIENT SITE PRINT
 ;;^UTILITY(U,$J,"OPT",1552,0)
 ;;=PSJ4 IS TO IWP^Move Inpatient Site To Inpatient Ward^^R^^^^^^^^INPATIENT MEDS V4 PRE-RELEASE
 ;;^UTILITY(U,$J,"OPT",1552,1,0)
 ;;=^^2^2^2910725^
 ;;^UTILITY(U,$J,"OPT",1552,1,1,0)
 ;;=  This allows the user to seed the Inpatient Ward Parameter file with data
 ;;^UTILITY(U,$J,"OPT",1552,1,2,0)
 ;;=from the Inpatient Site file.
 ;;^UTILITY(U,$J,"OPT",1552,25)
 ;;=PSJPRE42
 ;;^UTILITY(U,$J,"OPT",1552,"U")
 ;;=MOVE INPATIENT SITE TO INPATIE
 ;;^UTILITY(U,$J,"OPT",1553,0)
 ;;=PSJ4 MAN CREATE PD^Create Primary Drug (Manual)^^R^^^^^^^^INPATIENT MEDS V4 PRE-RELEASE
 ;;^UTILITY(U,$J,"OPT",1553,1,0)
 ;;=^^4^4^2920323^^^^
 ;;^UTILITY(U,$J,"OPT",1553,1,1,0)
 ;;=  This allows the user to create primary drugs and tie them to current
 ;;^UTILITY(U,$J,"OPT",1553,1,2,0)
 ;;=entries in the drug file.  Primary drugs are entries without a strength
 ;;^UTILITY(U,$J,"OPT",1553,1,3,0)
 ;;=or dose form, which are used in entering Medication orders by non-pharmacy
 ;;^UTILITY(U,$J,"OPT",1553,1,4,0)
 ;;=personnel.
 ;;^UTILITY(U,$J,"OPT",1553,25)
 ;;=PSJPRE4
 ;;^UTILITY(U,$J,"OPT",1553,"U")
 ;;=CREATE PRIMARY DRUG (MANUAL)
 ;;^UTILITY(U,$J,"OPT",1554,0)
 ;;=PSJ4 IS TO WG^Move Inpatient Site To Ward Group^^R^^^^^^^^INPATIENT MEDS V4 PRE-RELEASE

PSJ4I035
PSJ4I035 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^UTILITY(U,$J,"OPT",1554,1,0)
 ;;=^^2^2^2910725^
 ;;^UTILITY(U,$J,"OPT",1554,1,1,0)
 ;;=  This allows the user to move the pick list parameters from the Inpatient
 ;;^UTILITY(U,$J,"OPT",1554,1,2,0)
 ;;=Site file to the Ward Group file.
 ;;^UTILITY(U,$J,"OPT",1554,25)
 ;;=PSJPRE43
 ;;^UTILITY(U,$J,"OPT",1554,"U")
 ;;=MOVE INPATIENT SITE TO WARD GR
 ;;^UTILITY(U,$J,"OPT",1555,0)
 ;;=PSJ4 WG EDIT^Edit Ward Group Pick List Parameters^^R^^^^^^^^INPATIENT MEDS V4 PRE-RELEASE
 ;;^UTILITY(U,$J,"OPT",1555,1,0)
 ;;=^^2^2^2910820^^
 ;;^UTILITY(U,$J,"OPT",1555,1,1,0)
 ;;=  This allows the user to edit the Ward group fields pertaining to the
 ;;^UTILITY(U,$J,"OPT",1555,1,2,0)
 ;;=pick list.
 ;;^UTILITY(U,$J,"OPT",1555,25)
 ;;=ENWE^PSJPRE43
 ;;^UTILITY(U,$J,"OPT",1555,"U")
 ;;=EDIT WARD GROUP PICK LIST PARA
 ;;^UTILITY(U,$J,"OPT",1556,0)
 ;;=PSJ4 IWP EDIT^Edit Inpatient Ward Parameters File^^R^^^^^^^^INPATIENT MEDS V4 PRE-RELEASE
 ;;^UTILITY(U,$J,"OPT",1556,1,0)
 ;;=^^1^1^2910725^
 ;;^UTILITY(U,$J,"OPT",1556,1,1,0)
 ;;=  This allows the user to edit the Inpatient Ward Parameters file.
 ;;^UTILITY(U,$J,"OPT",1556,25)
 ;;=ENWE^PSJPRE42
 ;;^UTILITY(U,$J,"OPT",1556,"U")
 ;;=EDIT INPATIENT WARD PARAMETERS
 ;;^UTILITY(U,$J,"OPT",1557,0)
 ;;=PSJ4 MGR^Inpatient Meds V4 Pre-Release Menu^^M^^^^^^^^INPATIENT MEDS V4 PRE-RELEASE
 ;;^UTILITY(U,$J,"OPT",1557,1,0)
 ;;=^^3^3^2911002^^^^
 ;;^UTILITY(U,$J,"OPT",1557,1,1,0)
 ;;=  This is a set of options that allow a site to set up various parts of
 ;;^UTILITY(U,$J,"OPT",1557,1,2,0)
 ;;=the Inpatient Medications package so that the site can use the package
 ;;^UTILITY(U,$J,"OPT",1557,1,3,0)
 ;;=immediately after installing version 4 of the package.
 ;;^UTILITY(U,$J,"OPT",1557,10,0)
 ;;=^19.01PI^22^22
 ;;^UTILITY(U,$J,"OPT",1557,10,1,0)
 ;;=1550^12
 ;;^UTILITY(U,$J,"OPT",1557,10,1,"^")
 ;;=PSJ4 ADDITIVE TYPE
 ;;^UTILITY(U,$J,"OPT",1557,10,2,0)
 ;;=1551^7
 ;;^UTILITY(U,$J,"OPT",1557,10,2,"^")
 ;;=PSJ4 IS PRINT
 ;;^UTILITY(U,$J,"OPT",1557,10,3,0)
 ;;=1552^8
 ;;^UTILITY(U,$J,"OPT",1557,10,3,"^")
 ;;=PSJ4 IS TO IWP
 ;;^UTILITY(U,$J,"OPT",1557,10,4,0)
 ;;=1554^9
 ;;^UTILITY(U,$J,"OPT",1557,10,4,"^")
 ;;=PSJ4 IS TO WG
 ;;^UTILITY(U,$J,"OPT",1557,10,5,0)
 ;;=1556^10
 ;;^UTILITY(U,$J,"OPT",1557,10,5,"^")
 ;;=PSJ4 IWP EDIT
 ;;^UTILITY(U,$J,"OPT",1557,10,6,0)
 ;;=1553^4
 ;;^UTILITY(U,$J,"OPT",1557,10,6,"^")
 ;;=PSJ4 MAN CREATE PD
 ;;^UTILITY(U,$J,"OPT",1557,10,7,0)
 ;;=1555^11^
 ;;^UTILITY(U,$J,"OPT",1557,10,7,"^")
 ;;=PSJ4 WG EDIT
 ;;^UTILITY(U,$J,"OPT",1557,10,8,0)
 ;;=1558^6
 ;;^UTILITY(U,$J,"OPT",1557,10,8,"^")
 ;;=PSJ4 EPD
 ;;^UTILITY(U,$J,"OPT",1557,10,9,0)
 ;;=1559^3
 ;;^UTILITY(U,$J,"OPT",1557,10,9,"^")
 ;;=PSJ4 DRG PRINT
 ;;^UTILITY(U,$J,"OPT",1557,10,10,0)
 ;;=3751^1
 ;;^UTILITY(U,$J,"OPT",1557,10,10,"^")
 ;;=PSJ4 ACP
 ;;^UTILITY(U,$J,"OPT",1557,10,11,0)
 ;;=3752^2
 ;;^UTILITY(U,$J,"OPT",1557,10,11,"^")
 ;;=PSJ4 AC
 ;;^UTILITY(U,$J,"OPT",1557,10,12,0)
 ;;=3753^13
 ;;^UTILITY(U,$J,"OPT",1557,10,12,"^")
 ;;=PSJ4 SOLUTION TYPE
 ;;^UTILITY(U,$J,"OPT",1557,10,13,0)
 ;;=3754^14
 ;;^UTILITY(U,$J,"OPT",1557,10,13,"^")
 ;;=PSJ4 EDD
 ;;^UTILITY(U,$J,"OPT",1557,10,14,0)
 ;;=3755^15
 ;;^UTILITY(U,$J,"OPT",1557,10,14,"^")
 ;;=PSJ4 PRIMARY/IV DRUG PRINT
 ;;^UTILITY(U,$J,"OPT",1557,10,15,0)
 ;;=3756^16
 ;;^UTILITY(U,$J,"OPT",1557,10,15,"^")
 ;;=PSJ4 ADDITIVE TYPE PRINT
 ;;^UTILITY(U,$J,"OPT",1557,10,16,0)
 ;;=3757^17^

PSJ4I036
PSJ4I036 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^UTILITY(U,$J,"OPT",1557,10,16,"^")
 ;;=PSJ4 IV FLUID SOLUTIONS PRINT
 ;;^UTILITY(U,$J,"OPT",1557,10,17,0)
 ;;=3758^18
 ;;^UTILITY(U,$J,"OPT",1557,10,17,"^")
 ;;=PSJ4 PD/DD PRINT
 ;;^UTILITY(U,$J,"OPT",1557,10,18,0)
 ;;=3829^21^
 ;;^UTILITY(U,$J,"OPT",1557,10,18,"^")
 ;;=PSJ4 EDIT PROVIDER
 ;;^UTILITY(U,$J,"OPT",1557,10,19,0)
 ;;=3830^20^
 ;;^UTILITY(U,$J,"OPT",1557,10,19,"^")
 ;;=PSJ4 PROVIDER PRINT
 ;;^UTILITY(U,$J,"OPT",1557,10,20,0)
 ;;=3831^5
 ;;^UTILITY(U,$J,"OPT",1557,10,20,"^")
 ;;=PSJ4 SYNONYM MOVE
 ;;^UTILITY(U,$J,"OPT",1557,10,21,0)
 ;;=3832^19
 ;;^UTILITY(U,$J,"OPT",1557,10,21,"^")
 ;;=PSJ4 NPU REPORT
 ;;^UTILITY(U,$J,"OPT",1557,10,22,0)
 ;;=3833^22
 ;;^UTILITY(U,$J,"OPT",1557,10,22,"^")
 ;;=PSJ4 EDIT USER PARAMETERS
 ;;^UTILITY(U,$J,"OPT",1557,99)
 ;;=55270,38947
 ;;^UTILITY(U,$J,"OPT",1557,"U")
 ;;=INPATIENT MEDS V4 PRE-RELEASE 
 ;;^UTILITY(U,$J,"OPT",1558,0)
 ;;=PSJ4 EPD^Edit Primary Drug^^R^^^^^^^^INPATIENT MEDS V4 PRE-RELEASE
 ;;^UTILITY(U,$J,"OPT",1558,1,0)
 ;;=^^1^1^2910820^^^
 ;;^UTILITY(U,$J,"OPT",1558,1,1,0)
 ;;=  This allows you to edit the information pertaining to the Primary Drug.
 ;;^UTILITY(U,$J,"OPT",1558,25)
 ;;=ENE^PSJPRE41
 ;;^UTILITY(U,$J,"OPT",1558,"U")
 ;;=EDIT PRIMARY DRUG
 ;;^UTILITY(U,$J,"OPT",1559,0)
 ;;=PSJ4 DRG PRINT^Drug Print^^R^^^^^^^^INPATIENT MEDS V4 PRE-RELEASE
 ;;^UTILITY(U,$J,"OPT",1559,1,0)
 ;;=^^3^3^2910820^^
 ;;^UTILITY(U,$J,"OPT",1559,1,1,0)
 ;;=  This prints the entries of the site's Drug file, grouped together as
 ;;^UTILITY(U,$J,"OPT",1559,1,2,0)
 ;;=the Create Primary Drug option would group them.  This print may help
 ;;^UTILITY(U,$J,"OPT",1559,1,3,0)
 ;;=the site in deciding their primary drugs.
 ;;^UTILITY(U,$J,"OPT",1559,25)
 ;;=PSJPRE45
 ;;^UTILITY(U,$J,"OPT",1559,"U")
 ;;=DRUG PRINT
 ;;^UTILITY(U,$J,"OPT",3751,0)
 ;;=PSJ4 ACP^Auto-Create Print^^R^^^^^^^^INPATIENT MEDS V4 PRE-RELEASE
 ;;^UTILITY(U,$J,"OPT",3751,1,0)
 ;;=^^3^3^2910830^
 ;;^UTILITY(U,$J,"OPT",3751,1,1,0)
 ;;=  This allows the user to print the Unit Dose and IV entries from the local
 ;;^UTILITY(U,$J,"OPT",3751,1,2,0)
 ;;=Drug file and the Primary Drugs that will be created for these entries by
 ;;^UTILITY(U,$J,"OPT",3751,1,3,0)
 ;;=the auto-create option.
 ;;^UTILITY(U,$J,"OPT",3751,25)
 ;;=PSJPRE46
 ;;^UTILITY(U,$J,"OPT",3751,"U")
 ;;=AUTO-CREATE PRINT
 ;;^UTILITY(U,$J,"OPT",3752,0)
 ;;=PSJ4 AC^Auto-Create Primary Drug^^R^^^^^^^^INPATIENT MEDS V4 PRE-RELEASE
 ;;^UTILITY(U,$J,"OPT",3752,1,0)
 ;;=^^3^3^2920323^^
 ;;^UTILITY(U,$J,"OPT",3752,1,1,0)
 ;;=  This allows the user to auto-create Primary Drugs for the Unit Dose and
 ;;^UTILITY(U,$J,"OPT",3752,1,2,0)
 ;;=IV entries in the user's Drug file.  The National Drug File must be on-
 ;;^UTILITY(U,$J,"OPT",3752,1,3,0)
 ;;=line in order for this to work.
 ;;^UTILITY(U,$J,"OPT",3752,25)
 ;;=PSJPRE47
 ;;^UTILITY(U,$J,"OPT",3752,"U")
 ;;=AUTO-CREATE PRIMARY DRUG
 ;;^UTILITY(U,$J,"OPT",3753,0)
 ;;=PSJ4 SOLUTION TYPE^Mark Solutions for use in IV Fluids Order Entry^^R^^^^^^^^INPATIENT MEDS V4 PRE-RELEASE
 ;;^UTILITY(U,$J,"OPT",3753,1,0)
 ;;=^^9^9^2910925^^^^
 ;;^UTILITY(U,$J,"OPT",3753,1,1,0)
 ;;=  Allows editing of the USED IN IV FLUID ORDER ENTRY field of the IV 
 ;;^UTILITY(U,$J,"OPT",3753,1,2,0)
 ;;=SOLUTIONS file (52.7). Only solutions which have been marked will be
 ;;^UTILITY(U,$J,"OPT",3753,1,3,0)
 ;;=selectable when entering IV Fluid orders through the OE/RR package.

PSJ4I037
PSJ4I037 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^UTILITY(U,$J,"OPT",3753,1,4,0)
 ;;=Solutions having data in the PRINT LINE {2} field are assumed to be
 ;;^UTILITY(U,$J,"OPT",3753,1,5,0)
 ;;=multi-ingredient drugs, and may not be marked for use through OE/RR.
 ;;^UTILITY(U,$J,"OPT",3753,1,6,0)
 ;;= 
 ;;^UTILITY(U,$J,"OPT",3753,1,7,0)
 ;;=  This option is part of a pre-release of Inpatient Medications 4.0, and
 ;;^UTILITY(U,$J,"OPT",3753,1,8,0)
 ;;=is included to allow pharmacy to enter this information prior to the 
 ;;^UTILITY(U,$J,"OPT",3753,1,9,0)
 ;;=release of the complete package.
 ;;^UTILITY(U,$J,"OPT",3753,25)
 ;;=ENSOLT^PSJPRE41
 ;;^UTILITY(U,$J,"OPT",3753,"U")
 ;;=MARK SOLUTIONS FOR USE IN IV F
 ;;^UTILITY(U,$J,"OPT",3754,0)
 ;;=PSJ4 EDD^Edit Dispense Drug^^R^^^^^^^^INPATIENT MEDS V4 PRE-RELEASE
 ;;^UTILITY(U,$J,"OPT",3754,1,0)
 ;;=^^2^2^2910930^
 ;;^UTILITY(U,$J,"OPT",3754,1,1,0)
 ;;=  Allows the user to edit the Primary Drug field for dispense drugs (entries
 ;;^UTILITY(U,$J,"OPT",3754,1,2,0)
 ;;=in 50).
 ;;^UTILITY(U,$J,"OPT",3754,25)
 ;;=ENDDE^PSJPRE41
 ;;^UTILITY(U,$J,"OPT",3754,"U")
 ;;=EDIT DISPENSE DRUG
 ;;^UTILITY(U,$J,"OPT",3755,0)
 ;;=PSJ4 PRIMARY/IV DRUG PRINT^IV Drug Matched to Primary Drug Print^^R^^^^^^^^INPATIENT MEDS V4 PRE-RELEASE
 ;;^UTILITY(U,$J,"OPT",3755,1,0)
 ;;=^^4^4^2911002^
 ;;^UTILITY(U,$J,"OPT",3755,1,1,0)
 ;;=  This prints IV additives and solutions, and the generic drug and primary
 ;;^UTILITY(U,$J,"OPT",3755,1,2,0)
 ;;=drug linked to them. This print may be run for all additives and solutions, 
 ;;^UTILITY(U,$J,"OPT",3755,1,3,0)
 ;;=or only those linked to a generic drug that has been matched to a primary 
 ;;^UTILITY(U,$J,"OPT",3755,1,4,0)
 ;;=drug. This report may help in matching primary drugs to IV drugs.
 ;;^UTILITY(U,$J,"OPT",3755,25)
 ;;=ENPD^PSJPRE48
 ;;^UTILITY(U,$J,"OPT",3755,99)
 ;;=55115,52388
 ;;^UTILITY(U,$J,"OPT",3755,"U")
 ;;=IV DRUG MATCHED TO PRIMARY DRU
 ;;^UTILITY(U,$J,"OPT",3756,0)
 ;;=PSJ4 ADDITIVE TYPE PRINT^IV Additive Type Print^^R^^^^^^^^INPATIENT MEDS V4 PRE-RELEASE
 ;;^UTILITY(U,$J,"OPT",3756,1,0)
 ;;=^^4^4^2911017^^^^
 ;;^UTILITY(U,$J,"OPT",3756,1,1,0)
 ;;=  This print lists IV additives and the additive type, if one has been
 ;;^UTILITY(U,$J,"OPT",3756,1,2,0)
 ;;=entered. This report may be run to list all additives, or only those
 ;;^UTILITY(U,$J,"OPT",3756,1,3,0)
 ;;=assigned a type. This may be helpful when identifying additives as
 ;;^UTILITY(U,$J,"OPT",3756,1,4,0)
 ;;=multivitamins or electrolytes for use in IV Fluid order entry.
 ;;^UTILITY(U,$J,"OPT",3756,25)
 ;;=ENAD^PSJPRE48
 ;;^UTILITY(U,$J,"OPT",3756,"U")
 ;;=IV ADDITIVE TYPE PRINT
 ;;^UTILITY(U,$J,"OPT",3757,0)
 ;;=PSJ4 IV FLUID SOLUTIONS PRINT^IV Fluid Solutions Print^^R^^^^^^^^INPATIENT MEDS V4 PRE-RELEASE
 ;;^UTILITY(U,$J,"OPT",3757,1,0)
 ;;=^^3^3^2911002^
 ;;^UTILITY(U,$J,"OPT",3757,1,1,0)
 ;;=  This print lists solutions and the USED IN IV FLUID ORDER ENTRY field.
 ;;^UTILITY(U,$J,"OPT",3757,1,2,0)
 ;;=This report may be run to list all solutions, or only those marked for
 ;;^UTILITY(U,$J,"OPT",3757,1,3,0)
 ;;=use when entering IV Fluid orders through OE/RR.
 ;;^UTILITY(U,$J,"OPT",3757,25)
 ;;=ENSOL^PSJPRE48
 ;;^UTILITY(U,$J,"OPT",3757,"U")
 ;;=IV FLUID SOLUTIONS PRINT
 ;;^UTILITY(U,$J,"OPT",3758,0)
 ;;=PSJ4 PD/DD PRINT^Primary Drug/Dispense Drug Report^^R^^^^^^^^INPATIENT MEDS V4 PRE-RELEASE

PSJ4I038
PSJ4I038 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^UTILITY(U,$J,"OPT",3758,1,0)
 ;;=^^4^4^2911002^
 ;;^UTILITY(U,$J,"OPT",3758,1,1,0)
 ;;=  Allows the user to print primary drugs and the dispense drugs tied to
 ;;^UTILITY(U,$J,"OPT",3758,1,2,0)
 ;;=them.  The report can be sorted by primary drug or dispense drug.  The
 ;;^UTILITY(U,$J,"OPT",3758,1,3,0)
 ;;=report can also show exceptions - dispense drugs not yet tied to a primary
 ;;^UTILITY(U,$J,"OPT",3758,1,4,0)
 ;;=drug.
 ;;^UTILITY(U,$J,"OPT",3758,25)
 ;;=PSJPRE40
 ;;^UTILITY(U,$J,"OPT",3758,"U")
 ;;=PRIMARY DRUG/DISPENSE DRUG REP
 ;;^UTILITY(U,$J,"OPT",3829,0)
 ;;=PSJ4 EDIT PROVIDER^Edit Provider Fields in New Person File^^R^^^^^^^^
 ;;^UTILITY(U,$J,"OPT",3829,1,0)
 ;;=^^4^4^2920319^^^^
 ;;^UTILITY(U,$J,"OPT",3829,1,1,0)
 ;;= Allows editing of the AUTHORIZED TO WRITE MED ORDERS and INACTIVE DATE 
 ;;^UTILITY(U,$J,"OPT",3829,1,2,0)
 ;;=(Pharmacy) fields of the NEW PERSON file (200). Only providers who are 
 ;;^UTILITY(U,$J,"OPT",3829,1,3,0)
 ;;=marked as AUTHORIZED TO WRITE MED ORDERS in the NEW PERSON file are 
 ;;^UTILITY(U,$J,"OPT",3829,1,4,0)
 ;;=selectable through Inpatient Medications version 4.0.
 ;;^UTILITY(U,$J,"OPT",3829,25)
 ;;=ENE^PSJPRE49
 ;;^UTILITY(U,$J,"OPT",3829,"U")
 ;;=EDIT PROVIDER FIELDS IN NEW PE
 ;;^UTILITY(U,$J,"OPT",3830,0)
 ;;=PSJ4 PROVIDER PRINT^Active Provider Report^^R^^^^^^^^
 ;;^UTILITY(U,$J,"OPT",3830,1,0)
 ;;=^^11^11^2920319^^
 ;;^UTILITY(U,$J,"OPT",3830,1,1,0)
 ;;=  This lists all active providers in the PROVIDER File (6). The report
 ;;^UTILITY(U,$J,"OPT",3830,1,2,0)
 ;;=includes the following fields:
 ;;^UTILITY(U,$J,"OPT",3830,1,3,0)
 ;;= 
 ;;^UTILITY(U,$J,"OPT",3830,1,4,0)
 ;;=     NAME (From the NEW PERSON File)
 ;;^UTILITY(U,$J,"OPT",3830,1,5,0)
 ;;=     INACTIVATION DATE (From the PROVIDER File)
 ;;^UTILITY(U,$J,"OPT",3830,1,6,0)
 ;;=     INACTIVE DATE (For Pharmacy, from the NEW PERSON File)
 ;;^UTILITY(U,$J,"OPT",3830,1,7,0)
 ;;=     AUTHORIZED TO WRITE MED ORDERS (From the NEW PERSON File)
 ;;^UTILITY(U,$J,"OPT",3830,1,8,0)
 ;;= 
 ;;^UTILITY(U,$J,"OPT",3830,1,9,0)
 ;;=  Only providers who are marked as AUTHORIZED TO WRITE MED ORDERS in the
 ;;^UTILITY(U,$J,"OPT",3830,1,10,0)
 ;;=NEW PERSON File (200) are selectable through Inpatient Medications
 ;;^UTILITY(U,$J,"OPT",3830,1,11,0)
 ;;=version 4.0
 ;;^UTILITY(U,$J,"OPT",3830,25)
 ;;=ENP^PSJPRE49
 ;;^UTILITY(U,$J,"OPT",3830,"U")
 ;;=ACTIVE PROVIDER REPORT
 ;;^UTILITY(U,$J,"OPT",3831,0)
 ;;=PSJ4 SYNONYM MOVE^Synonym Move From Drug File To Primary Drug File^^R^^^^^^^^INPATIENT MEDS V4 PRE-RELEASE
 ;;^UTILITY(U,$J,"OPT",3831,1,0)
 ;;=^^5^5^2920323^^
 ;;^UTILITY(U,$J,"OPT",3831,1,1,0)
 ;;=  This allows the user to copy the synonyms in the Drug file to the Primary
 ;;^UTILITY(U,$J,"OPT",3831,1,2,0)
 ;;=Drug file for those items in the Drug file that have a Primary drug.  Only
 ;;^UTILITY(U,$J,"OPT",3831,1,3,0)
 ;;=synonyms that have been marked as TRADE NAMES are copied.  This should not
 ;;^UTILITY(U,$J,"OPT",3831,1,4,0)
 ;;=be run until the Primary Drug Manual Create option has been run to
 ;;^UTILITY(U,$J,"OPT",3831,1,5,0)
 ;;=completion.
 ;;^UTILITY(U,$J,"OPT",3831,25)
 ;;=ENSYN^PSJPRE41
 ;;^UTILITY(U,$J,"OPT",3831,"U")
 ;;=SYNONYM MOVE FROM DRUG FILE TO
 ;;^UTILITY(U,$J,"OPT",3832,0)
 ;;=PSJ4 NPU REPORT^New Person User Report^^R^^^^^^^^INPATIENT MEDS V4 PRE-RELEASE
 ;;^UTILITY(U,$J,"OPT",3832,1,0)
 ;;=^^5^5^2920322^

PSJ4I039
PSJ4I039 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^UTILITY(U,$J,"OPT",3832,1,1,0)
 ;;=  This shows the sites how version 4 of the Inpatient Medications package
 ;;^UTILITY(U,$J,"OPT",3832,1,2,0)
 ;;=will see users - as a pharmacist, nurse, pharmacy technician or ward clerk.
 ;;^UTILITY(U,$J,"OPT",3832,1,3,0)
 ;;=This report will also show users that version 4 will see as valid medication
 ;;^UTILITY(U,$J,"OPT",3832,1,4,0)
 ;;=providers.  Users not listed on the report will be seen by version 4 as
 ;;^UTILITY(U,$J,"OPT",3832,1,5,0)
 ;;=ward clerks.
 ;;^UTILITY(U,$J,"OPT",3832,25)
 ;;=ENTOUR^PSJPRE41
 ;;^UTILITY(U,$J,"OPT",3832,"U")
 ;;=NEW PERSON USER REPORT
 ;;^UTILITY(U,$J,"OPT",3833,0)
 ;;=PSJ4 EDIT USER PARAMETERS^Edit User Parameters^^R^^^^^^^^INPATIENT MEDS V4 PRE-RELEASE
 ;;^UTILITY(U,$J,"OPT",3833,1,0)
 ;;=^^3^3^2920323^
 ;;^UTILITY(U,$J,"OPT",3833,1,1,0)
 ;;=  Allows an Inpatient Supervisor or Inpatient ADP Coordinator to determine
 ;;^UTILITY(U,$J,"OPT",3833,1,2,0)
 ;;=how version 4 of the Inpatient Medications package will work for specific
 ;;^UTILITY(U,$J,"OPT",3833,1,3,0)
 ;;=users.
 ;;^UTILITY(U,$J,"OPT",3833,25)
 ;;=ENEUP^PSJPRE41
 ;;^UTILITY(U,$J,"OPT",3833,"U")
 ;;=EDIT USER PARAMETERS
 ;;^UTILITY(U,$J,"PKG",149,0)
 ;;=INPATIENT MEDS V4 PRE-RELEASE^PSJ4^PRE-RELEASE PACKET FOR INPATIENT MEDS VERSION 4
 ;;^UTILITY(U,$J,"PKG",149,1,0)
 ;;=^^4^4^2910728^^
 ;;^UTILITY(U,$J,"PKG",149,1,1,0)
 ;;=  This is a set of utilities to create data for use with version 4 of the
 ;;^UTILITY(U,$J,"PKG",149,1,2,0)
 ;;=Inpatient Medications package.  By installing this package and running the
 ;;^UTILITY(U,$J,"PKG",149,1,3,0)
 ;;=options, the site can have the data ready for version 4.  This will allow
 ;;^UTILITY(U,$J,"PKG",149,1,4,0)
 ;;=the site to immediately run version 4 immediately after it is installed.
 ;;^UTILITY(U,$J,"PKG",149,4,0)
 ;;=^9.44PA^12^11
 ;;^UTILITY(U,$J,"PKG",149,4,1,0)
 ;;=50
 ;;^UTILITY(U,$J,"PKG",149,4,1,1,0)
 ;;=^9.45A^9^6
 ;;^UTILITY(U,$J,"PKG",149,4,1,1,4,0)
 ;;=FORMULARY ALTERNATIVE
 ;;^UTILITY(U,$J,"PKG",149,4,1,1,5,0)
 ;;=NON-FORMULARY
 ;;^UTILITY(U,$J,"PKG",149,4,1,1,6,0)
 ;;=PRIMARY DRUG
 ;;^UTILITY(U,$J,"PKG",149,4,1,1,7,0)
 ;;=VA CLASSIFICATION
 ;;^UTILITY(U,$J,"PKG",149,4,1,1,8,0)
 ;;=NATIONAL DRUG FILE ENTRY
 ;;^UTILITY(U,$J,"PKG",149,4,1,1,9,0)
 ;;=PSNDF VA PRODUCT NAME ENTRY
 ;;^UTILITY(U,$J,"PKG",149,4,1,1,"B","FORMULARY ALTERNATIVE",4)
 ;;=
 ;;^UTILITY(U,$J,"PKG",149,4,1,1,"B","NATIONAL DRUG FILE ENTRY",8)
 ;;=
 ;;^UTILITY(U,$J,"PKG",149,4,1,1,"B","NON-FORMULARY",5)
 ;;=
 ;;^UTILITY(U,$J,"PKG",149,4,1,1,"B","PRIMARY DRUG",6)
 ;;=
 ;;^UTILITY(U,$J,"PKG",149,4,1,1,"B","PSNDF VA PRODUCT NAME ENTRY",9)
 ;;=
 ;;^UTILITY(U,$J,"PKG",149,4,1,1,"B","VA CLASSIFICATION",7)
 ;;=
 ;;^UTILITY(U,$J,"PKG",149,4,1,222)
 ;;=y^n^^n^^^n
 ;;^UTILITY(U,$J,"PKG",149,4,2,0)
 ;;=57.5
 ;;^UTILITY(U,$J,"PKG",149,4,2,1,0)
 ;;=^9.45A^6^6
 ;;^UTILITY(U,$J,"PKG",149,4,2,1,1,0)
 ;;=PICK LIST - ROOM/BED SORT
 ;;^UTILITY(U,$J,"PKG",149,4,2,1,2,0)
 ;;=PICK LIST - OMIT WARD SORT
 ;;^UTILITY(U,$J,"PKG",149,4,2,1,3,0)
 ;;=PICK LIST - OMIT ROOM-BED SORT
 ;;^UTILITY(U,$J,"PKG",149,4,2,1,4,0)
 ;;=PICK LIST - FORM FEED/PATIENT
 ;;^UTILITY(U,$J,"PKG",149,4,2,1,5,0)
 ;;=PICK LIST - FORM FEED/WARD
 ;;^UTILITY(U,$J,"PKG",149,4,2,1,6,0)
 ;;=PICK LIST - LINES ON FORM FEED
 ;;^UTILITY(U,$J,"PKG",149,4,2,1,"B","PICK LIST - FORM FEED/PATIENT",4)
 ;;=

PSJ4I040
PSJ4I040 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^UTILITY(U,$J,"PKG",149,4,2,1,"B","PICK LIST - FORM FEED/WARD",5)
 ;;=
 ;;^UTILITY(U,$J,"PKG",149,4,2,1,"B","PICK LIST - LINES ON FORM FEED",6)
 ;;=
 ;;^UTILITY(U,$J,"PKG",149,4,2,1,"B","PICK LIST - OMIT ROOM-BED SORT",3)
 ;;=
 ;;^UTILITY(U,$J,"PKG",149,4,2,1,"B","PICK LIST - OMIT WARD SORT",2)
 ;;=
 ;;^UTILITY(U,$J,"PKG",149,4,2,1,"B","PICK LIST - ROOM/BED SORT",1)
 ;;=
 ;;^UTILITY(U,$J,"PKG",149,4,2,222)
 ;;=y^n^^n^^^n
 ;;^UTILITY(U,$J,"PKG",149,4,3,0)
 ;;=59.6
 ;;^UTILITY(U,$J,"PKG",149,4,3,222)
 ;;=y^n^^n^^^n
 ;;^UTILITY(U,$J,"PKG",149,4,5,0)
 ;;=59.7
 ;;^UTILITY(U,$J,"PKG",149,4,5,1,0)
 ;;=^9.45A^3^2
 ;;^UTILITY(U,$J,"PKG",149,4,5,1,2,0)
 ;;=DATE V4 PRE-PACKET INSTALLED
 ;;^UTILITY(U,$J,"PKG",149,4,5,1,3,0)
 ;;=PRIMARY DRUG CONVERSION DATE
 ;;^UTILITY(U,$J,"PKG",149,4,5,1,"B","DATE V4 PRE-PACKET INSTALLED",2)
 ;;=
 ;;^UTILITY(U,$J,"PKG",149,4,5,1,"B","PRIMARY DRUG CONVERSION DATE",3)
 ;;=
 ;;^UTILITY(U,$J,"PKG",149,4,5,222)
 ;;=y^^^n^^^n
 ;;^UTILITY(U,$J,"PKG",149,4,6,0)
 ;;=50.3
 ;;^UTILITY(U,$J,"PKG",149,4,6,222)
 ;;=y^n^^n^^^n
 ;;^UTILITY(U,$J,"PKG",149,4,7,0)
 ;;=59.5
 ;;^UTILITY(U,$J,"PKG",149,4,7,1,0)
 ;;=^9.45A^1^1
 ;;^UTILITY(U,$J,"PKG",149,4,7,1,1,0)
 ;;=NAME
 ;;^UTILITY(U,$J,"PKG",149,4,7,1,"B","NAME",1)
 ;;=
 ;;^UTILITY(U,$J,"PKG",149,4,7,222)
 ;;=y^^^n^^^n
 ;;^UTILITY(U,$J,"PKG",149,4,8,0)
 ;;=52.6
 ;;^UTILITY(U,$J,"PKG",149,4,8,1,0)
 ;;=^9.45A^3^3
 ;;^UTILITY(U,$J,"PKG",149,4,8,1,1,0)
 ;;=GENERIC DRUG
 ;;^UTILITY(U,$J,"PKG",149,4,8,1,2,0)
 ;;=PRIMARY DRUG
 ;;^UTILITY(U,$J,"PKG",149,4,8,1,3,0)
 ;;=TYPE
 ;;^UTILITY(U,$J,"PKG",149,4,8,1,"B","GENERIC DRUG",1)
 ;;=
 ;;^UTILITY(U,$J,"PKG",149,4,8,1,"B","PRIMARY DRUG",2)
 ;;=
 ;;^UTILITY(U,$J,"PKG",149,4,8,1,"B","TYPE",3)
 ;;=
 ;;^UTILITY(U,$J,"PKG",149,4,8,222)
 ;;=y^n^^n^^^n
 ;;^UTILITY(U,$J,"PKG",149,4,9,0)
 ;;=52.7
 ;;^UTILITY(U,$J,"PKG",149,4,9,1,0)
 ;;=^9.45A^3^3
 ;;^UTILITY(U,$J,"PKG",149,4,9,1,1,0)
 ;;=GENERIC DRUG
 ;;^UTILITY(U,$J,"PKG",149,4,9,1,2,0)
 ;;=PRIMARY DRUG
 ;;^UTILITY(U,$J,"PKG",149,4,9,1,3,0)
 ;;=USED IN IV FLUID ORDER ENTRY
 ;;^UTILITY(U,$J,"PKG",149,4,9,1,"B","GENERIC DRUG",1)
 ;;=
 ;;^UTILITY(U,$J,"PKG",149,4,9,1,"B","PRIMARY DRUG",2)
 ;;=
 ;;^UTILITY(U,$J,"PKG",149,4,9,1,"B","USED IN IV FLUID ORDER ENTRY",3)
 ;;=
 ;;^UTILITY(U,$J,"PKG",149,4,9,222)
 ;;=y^n^^n^^^n
 ;;^UTILITY(U,$J,"PKG",149,4,10,0)
 ;;=50.35
 ;;^UTILITY(U,$J,"PKG",149,4,10,222)
 ;;=y^n^^n^^^y^o^n
 ;;^UTILITY(U,$J,"PKG",149,4,11,0)
 ;;=58.1
 ;;^UTILITY(U,$J,"PKG",149,4,11,222)
 ;;=y^^^n^^^n
 ;;^UTILITY(U,$J,"PKG",149,4,12,0)
 ;;=53.45
 ;;^UTILITY(U,$J,"PKG",149,4,12,1,0)
 ;;=^9.45A^6^6
 ;;^UTILITY(U,$J,"PKG",149,4,12,1,1,0)
 ;;=ALLOW USER TO RENEW ORDERS
 ;;^UTILITY(U,$J,"PKG",149,4,12,1,2,0)
 ;;=ALLOW USER TO HOLD ORDERS
 ;;^UTILITY(U,$J,"PKG",149,4,12,1,3,0)
 ;;=ALLOW USER TO CANCEL ORDERS
 ;;^UTILITY(U,$J,"PKG",149,4,12,1,4,0)
 ;;=MAY SELECT DISPENSE DRUGS
 ;;^UTILITY(U,$J,"PKG",149,4,12,1,5,0)
 ;;=ALLOW AUTO-VERIFY FOR USER
 ;;^UTILITY(U,$J,"PKG",149,4,12,1,6,0)
 ;;=ORDER ENTRY PROCESS
 ;;^UTILITY(U,$J,"PKG",149,4,12,1,"B","ALLOW AUTO-VERIFY FOR USER",5)
 ;;=
 ;;^UTILITY(U,$J,"PKG",149,4,12,1,"B","ALLOW USER TO CANCEL ORDERS",3)
 ;;=
 ;;^UTILITY(U,$J,"PKG",149,4,12,1,"B","ALLOW USER TO HOLD ORDERS",2)
 ;;=
 ;;^UTILITY(U,$J,"PKG",149,4,12,1,"B","ALLOW USER TO RENEW ORDERS",1)
 ;;=
 ;;^UTILITY(U,$J,"PKG",149,4,12,1,"B","MAY SELECT DISPENSE DRUGS",4)
 ;;=

PSJ4I041
PSJ4I041 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^UTILITY(U,$J,"PKG",149,4,12,1,"B","ORDER ENTRY PROCESS",6)
 ;;=
 ;;^UTILITY(U,$J,"PKG",149,4,12,222)
 ;;=y^^^n^^^n
 ;;^UTILITY(U,$J,"PKG",149,4,"B",50,1)
 ;;=
 ;;^UTILITY(U,$J,"PKG",149,4,"B",50.3,6)
 ;;=
 ;;^UTILITY(U,$J,"PKG",149,4,"B",50.35,10)
 ;;=
 ;;^UTILITY(U,$J,"PKG",149,4,"B",52.6,8)
 ;;=
 ;;^UTILITY(U,$J,"PKG",149,4,"B",52.7,9)
 ;;=
 ;;^UTILITY(U,$J,"PKG",149,4,"B",53.45,12)
 ;;=
 ;;^UTILITY(U,$J,"PKG",149,4,"B",57.5,2)
 ;;=
 ;;^UTILITY(U,$J,"PKG",149,4,"B",58.1,11)
 ;;=
 ;;^UTILITY(U,$J,"PKG",149,4,"B",59.5,7)
 ;;=
 ;;^UTILITY(U,$J,"PKG",149,4,"B",59.6,3)
 ;;=
 ;;^UTILITY(U,$J,"PKG",149,4,"B",59.7,5)
 ;;=
 ;;^UTILITY(U,$J,"PKG",149,5)
 ;;=BIRMINGHAM
 ;;^UTILITY(U,$J,"PKG",149,7)
 ;;=BIRMINGHAM^^I
 ;;^UTILITY(U,$J,"PKG",149,11)
 ;;=50^59.9
 ;;^UTILITY(U,$J,"PKG",149,22,0)
 ;;=^9.49I^3.2^2
 ;;^UTILITY(U,$J,"PKG",149,22,3.2,0)
 ;;=3.2^2920519^2920108
 ;;^UTILITY(U,$J,"PKG",149,22,4,0)
 ;;=4^2910728
 ;;^UTILITY(U,$J,"PKG",149,22,"B",3.2,3.2)
 ;;=
 ;;^UTILITY(U,$J,"PKG",149,22,"B",4,4)
 ;;=
 ;;^UTILITY(U,$J,"PKG",149,"DEV")
 ;;=LINK,CHARLES/B'HAM ISC
 ;;^UTILITY(U,$J,"PKG",149,"INIT")
 ;;=PSJPRE4P
 ;;^UTILITY(U,$J,"PKG",149,"PRE")
 ;;=PSJPRE4I^2910904.220631

PSJ4INI0
PSJ4INI0 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 K ^UTILITY("DIF",$J) F I=1:1:22 S ^UTILITY("DIF",$J,I)=$T(IXF+I)
 Q
IXF ;;INPATIENT MEDS V4 PRE-RELEASE^PSJ4
 ;;50I;DRUG;^PSDRUG(;1;y;n;;n;;;n
 ;;
 ;;50.3I;PRIMARY DRUG;^PS(50.3,;0;y;n;;n;;;n
 ;;
 ;;50.35I;DRUG APPLICATION;^PS(50.35,;0;y;n;;n;;;y;o;n
 ;;
 ;;52.6I;IV ADDITIVES;^PS(52.6,;1;y;n;;n;;;n
 ;;
 ;;52.7I;IV SOLUTIONS;^PS(52.7,;1;y;n;;n;;;n
 ;;
 ;;53.45P;INPATIENT USER PARAMETERS;^PS(53.45,;1;y;;;n;;;n
 ;;
 ;;57.5I;WARD GROUP;^PS(57.5,;1;y;n;;n;;;n
 ;;
 ;;58.1I;PHARMACY AOU STOCK;^PSI(58.1,;0;y;;;n;;;n
 ;;
 ;;59.5;IV ROOM;^PS(59.5,;1;y;;;n;;;n
 ;;
 ;;59.6P;INPATIENT WARD PARAMETERS;^PS(59.6,;0;y;n;;n;;;n
 ;;
 ;;59.7;PHARMACY SYSTEM;^PS(59.7,;1;y;;;n;;;n
 ;;

PSJ4INI1
PSJ4INI1 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 ; LOADS AND INDEXES DD'S
 ;
 K DIF,DIK,D,DDF,DDT,DTO,D0,DLAYGO,DIC,DIDUZ,DIR,DA,DFR,DTN,DIX,DZ D DT^DICRW S %=1,U="^",DSEC=1
 S NO=$P("I 0^I $D(@X)#2,X[U",U,%) I %<1 K DIFQ Q
ASK I %=1,$D(DIFQ(0)) W !,"SHALL I WRITE OVER FILE SECURITY CODES" S %=2 D YN^DICN S DSEC=%=1 I %<1 K DIFQ Q
 F X="DIE","OPT" D W Q:'$D(DIFQ)
 Q:'$D(DIFQ)  S %=0 W !!,"ARE YOU SURE EVERYTHING'S OK" D YN^DICN I %-1 K DIFQ Q
 I $D(DIFKEP) F DIDIU=0:0 S DIDIU=$N(DIFKEP(DIDIU)) Q:DIDIU'>0  S DIU=DIDIU,DIU(0)=DIFKEP(DIDIU) D EN^DIU2
 D DT^DICRW K ^UTILITY(U,$J),^UTILITY("DIK",$J) D WAIT^DICD
 S DN="^PSJ4I" F R=1001:1:1041 D ROU W "."
 F D=50,50.065,50.3,50.31,50.311,50.32,50.35,52.6,52.7,53.45,57.5,58.1,58.11,59.5,59.6,59.7 D IX
DATA W "." S (D,DDF(1),DDT(0))=$N(^UTILITY(U,$J,0)) Q:D'>0
 I DIFQR(D) S DTO=0,DMRG=1,DTO(0)=^(D),Z=^(D)_"0)",D0=^(D,0),@Z=D0,DFR(1)="^UTILITY(U,$J,DDF(1),D0,",DKP=DIFQR(D)'=2 F D0=0:0 S D0=$N(^UTILITY(U,$J,DDF(1),D0)) Q:'$D(^(D0,0))  S Z=^(0) D I^DITR
 K ^UTILITY(U,$J,DDF(1)),DDF,DDT,DTO,DFR,DFN,DTN G DATA
 ;
W S Y=$P($T(@X),";",2) W !,"NOTE: This package also contains "_Y_"S",! Q:'$D(DIFQ(0))
 S %=1 W ?6,"SHALL I WRITE OVER EXISTING "_Y_"S OF THE SAME NAME" D YN^DICN I '% W !?6,"Answer YES to replace the current "_Y_"S with the incoming ones." G W
 S:%=2 DIFQ(X)=0 K:%<0 DIFQ
 Q
 ;
OPT ;OPTION
RTN ;ROUTINE DOCUMENTATION NOTE
FUN ;FUNCTION
BUL ;BULLETIN
KEY ;SECURITY KEY
HEL ;HELP FRAME
DIP ;PRINT TEMPLATE
DIE ;INPUT TEMPLATE
DIB ;SORT TEMPLATE
 ;
IX W "." S DIK="A" F %=0:0 S DIK=$N(^DD(D,DIK)) Q:DIK<0  K ^(DIK)
 S DA(1)=D,DIK="^DD("_D_"," D IXALL^DIK
 I $D(^DIC(D,"%",0)) S DIK="^DIC(D,""%""," G IXALL^DIK
 Q
ROU I R<2000 D @(DN_$E(R,2,4)) Q
 I R=2000 S R=2028
 S %C=R#52+65,%B=R-2028\52+65 S:%B>90 %B=%B+6 S:%C>90 %C=%C+6
 D @(DN_$C(48,%B,%C))
 Q
MSG ;
 I $P(^XMB(3.9,XMZ,0),U,7)'="X" Q
 S X=$S($D(^XMB(3.9,XMZ,2,XCN,0)):^(0),1:"") Q:X=""
M0 D M1 Q:$P(X,"$END MESSAGE")=""  D SAVE,NT G M0
NT S XCN=$O(^XMB(3.9,XMZ,2,XCN)) Q:XCN'?1.N  S X=^(XCN,0) Q
SAVE D NT Q:$E(X)="$"  S Y=X D NT Q:$E(X)="$"
 I $A(X)=126 S A0=X D NT S X=A0_$E(X,2,999) K A0
 S:% @Y=$E(X,2,999) G SAVE
 Q
M1 S Y=$E(X,2,4),%=0 I Y="DDD" S D=+$P(X,"(#",2),%=DIFQ(D) Q:D  S:$P(X,"(#",2)["FILE SECURITY" %=DSEC Q
 Q:Y="END"
 I Y="DTA" S %=DIFQR(D) Q
 I $T(@Y)]"" S %=1 Q
 Q

PSJ4INI2
PSJ4INI2 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 ;
 ;
 K ^UTILITY("DIFROM",$J),DIC S DIDUZ=0 S:$D(DUZ)#2 DIDUZ=DUZ S DUZ=.5
 I $D(^DIC(9.2,0))#2,^(0)?1"HEL".E S (DIC,DLAYGO)=9.2,N="HEL",DIC(0)="LX" G ADD
 Q
 ;
ADD F R=0:0 S R=$N(^UTILITY(U,$J,N,R)) Q:R<0  S X=$P(^(R,0),U,1) W "." D ^DIC I Y>0,'$D(DIFQ(N))!$P(Y,U,3) S ^UTILITY("DIFROM",$J,N,X)=+Y K ^DIC(9.2,+Y,1),^(2),^(3) S %X="^UTILITY(U,$J,N,R,",%Y=DIC_"+Y,",DA=+Y D %XY^%RCR
 S DIK=DIC
HELP S R=$N(^UTILITY("DIFROM",$J,N,R)) Q:R<0  W !,"'"_R_"' Help Frame filed." S DA=^(R) G IX:$N(^DIC(9.2,DA,2,0))'>0
 F X=0:0 S X=$N(^DIC(9.2,DA,2,X)) Q:X'>0  S I=$S($D(^(X,0)):^(0),1:0),Y=$P(I,U,2) S:Y]"" Y=$N(^DIC(9.2,"B",Y,0)) S ^(0)=$P(^DIC(9.2,DA,2,X,0),U,1)_U_$S(Y>0:Y,1:"")_U_$P(^(0),U,3,99)
IX D IX1^DIK G HELP
 ;
U I %<0 S DIFQ=1
 W ! Q
REP S DIR(0)="Y",DIR("A")="Shall I change the NAME of the file to "_DIF
 S DIR("??")="^D REP^DIFROMH1",DIR("B")="NO" D ^DIR G U:$D(DIRUT)
 I Y S DIE=1,DIFQ=0,DA=N,DR=".01////"_DIF D ^DIE Q
 S DIR("A")="Shall I replace your file with mine"
 S DIR("??")="^D AG^DIFROMH1" D ^DIR G U:$D(DIRUT)!'Y
 S DIU(0)="E",DIR("A")="Do you want to keep the Data"
 S DIR("??")="^D CHG^DIFROMH1" D ^DIR G U:$D(DIRUT)
 S:'Y DIU(0)=DIU(0)_"D"
 S DIR("A")="Do you want to keep the Templates"
 S DIR("??")="^D TEMP^DIFROMH1" D ^DIR G U:$D(DIRUT) S:'Y DIU(0)=DIU(0)_"T"
 S DIFKEP(N)=DIU(0) W !?15," (",DIF,") " Q

PSJ4INI3
PSJ4INI3 ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 ;
 ;
 K ^UTILITY("DIFROM",$J) S DIC(0)="LX",(DIC,DLAYGO)=3.6,N="BUL" D ADD:$D(^XMB(3.6,0))
 S X=0 F R=0:0 S X=$N(^UTILITY("DIFROM",$J,N,X)) Q:X<0  W !,"'",X,"' BULLETIN FILED -- Remember to add its user groups."
 I $D(^DIC(9.4,0))#2,^(0)?1"PACK".E S N="PKG",(DIC,DLAYGO)=9.4 D ADD
 G NP:'$D(DA) S:$D(^DIC(9.4,DA,22,DIFROM,0)) $P(^(0),U,3)=DT
 I $D(^DIC(9.4,DA,0))#2 S %=$P(^(0),U,4) I %]"" S %=$N(^DIC(9.2,"B",%,0)) S:%]"" $P(^DIC(9.4,DA,0),U,4)=%
 G NP:'$D(^ORD(100.99))!'$O(^UTILITY(U,$J,"OR",""))
 S %X="^UTILITY(U,$J,""OR"","_$O(^(""))_",",DIK="^ORD(100.99,1,5,",%Y=DIK_DA_","
 S:'$D(^ORD(100.99,1,5,0)) ^(0)="^100.995P^^"
 D %XY^%RCR S $P(^ORD(100.99,1,5,DA,0),U)=DA,%=$P(^(0),U,4)
 I %]"" S %=$N(^ORD(100.98,"B",%,0)) I %>0 S $P(^ORD(100.99,1,5,DA,0),U,4)=%
 S DA(1)=1 D IX1^DIK
NP K ^UTILITY("DIFROM",$J) I $D(^DIC(19,0))#2,^(0)?1"OPTION".E S (DIC,DLAYGO)=19,N="OPT" D ADD,OP
 I $D(^DIC(19.1,0))#2,^(0)?1"SECUR".E S (DIC,DLAYGO)=19.1,N="KEY" D ADD K ^UTILITY("DIFROM",$J)
 I $D(^DIC(9.8,0))#2,^(0)?1"ROUTINE^".E S (DIC,DLAYGO)=9.8,N="RTN" D ADD
 S DIC=.5,DLAYGO=0,N="FUN" D ADD
 S DIC("S")="I $P(^(0),U,4)=I" F N="DIPT","DIBT","DIE" S DIC=U_N_"(" D ADD
 K ^UTILITY(U,$J),DIC,DLAYGO F DIFR="DIE","DIPT" D DIEZ
 K ^UTILITY("DIFROM",$J) Q
DIEZ I ^DD("VERSION")>17.4,'$D(DISYS) D OS^DII
 E  S DISYS=^DD("OS")
 Q:'$D(^DD("OS",DISYS,"ZS"))
 S DIFR1=""
DZ1 S DIFR1=$O(^UTILITY("DIFROM",$J,DIFR,DIFR1)) Q:DIFR1=""
 F DIFR2=0:0 S DIFR2=$O(^UTILITY("DIFROM",$J,DIFR,DIFR1,DIFR2)) Q:'DIFR2  S Y=DIFR2 I $D(@(U_DIFR_"(Y,""ROU"")")) K ^("ROU") I $D(^("ROUOLD")) S X=^("ROUOLD"),DMAX=^DD("ROU") D:X]"" @("EN^DI"_$E(DIFR,3)_"Z")
 G DZ1
 ;
OP S R=$O(^UTILITY("DIFROM",$J,N,R)) I R="" K ^UTILITY("DIFROM",$J) G Q
 W !,"'"_R_"' Option Filed" S DA=+^UTILITY("DIFROM",$J,N,R) G:$P(^(R),U,2,3)="XUCORE^"!($P(^(R),U,2,3)="XUCOMMAND^") OP
 S %=$P(^DIC(19,DA,0),U,12) S:%]"" %=$O(^DIC(9.4,"B",%,0))
 S $P(^DIC(19,DA,0),U,12)=%,%=$P(^(0),U,7),(DZ,DIX)=0
 S:%]"" %=$O(^DIC(9.2,"B",%,0)) S $P(^DIC(19,DA,0),U,7)=%,%=$P(^(0),U,4),%="MOQXL"[% K ^(10,"B"),^("C")
 F X=0:0 S X=$O(^DIC(19,DA,10,X)) Q:'X  S I=$S($D(^(X,0)):^(0),1:0),Y=$S($D(^(U)):^(U),1:"") K ^DIC(19,DA,10,X) I Y]"",% S D=$O(^DIC(19,"B",Y,0)) I D S ^DIC(19,DA,10,X,0)=D_U_$P(I,U,2,9),DZ=DZ+1,DIX=X
 S:% ^DIC(19,DA,10,0)="^19.01PI^"_DZ_U_DIX D IX1^DIK G OP
 ;
ADD F R=0:0 S R=$O(^UTILITY(U,$J,N,R)) Q:R=""  S X=$P(^(R,0),U),I=$P(^(0),U,4) W "." D ^DIC I Y>0,'$D(DIFQ(N))!$P(Y,U,3) S Y=Y_U D A
Q Q
A K:N'="KEY"&(N'="OPT") @(DIC_"+Y)") S ^UTILITY("DIFROM",$J,N,X)=Y S:$E(N,1,2)="DI" ^(X,+Y)="" S:N="PKG" DIFROM(0)=+Y Q:$P(Y,U,2,3)="XUCORE^"!($P(Y,U,2,3)="XUCOMMAND^")
 I N="OPT" S:$P(^DIC(19,+Y,0),U,6)]"" DIOPT=$P(^(0),U,6) I $O(^UTILITY(U,$J,N,R,1,0)) K ^DIC(19,+Y,1)
 S %X="^UTILITY(U,$J,N,R,",%Y=DIC_"+Y,",DA=+Y,DIK=DIC D %XY^%RCR,IX1^DIK:N'="OPT" I N="OPT",$D(DIOPT) S:$P(^DIC(19,DA,0),U,6)="" $P(^(0),U,6)=DIOPT K DIOPT

PSJ4INIT
PSJ4INIT ; ; 19-MAY-1992
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 ;
 K DIF,DIK,DDF,DDT,DTO,D0,DLAYGO,DIC,DIDUZ,DIR,DA,DIFROM,DFR,DTN,DIX,DZ
 S U="^",DIFQ=0,DIFROM=3.2 W !,"This version (#3.2) of 'PSJ4INIT' was created on 19-MAY-1992"
 W !?9,"(at BIRMINGHAM, by VA FileMan V.18)",!
 I $D(^DD("VERSION")),^("VERSION")'<18 G GO:$N(^("VERSION",18))<0 W !,"BUT I'M OBSOLETE!!" G Q
 W !,"FIRST, I'LL FRESHEN UP YOUR VA FILEMAN...." D N^DINIT
 I ^DD("VERSION")<18 W !,"BUT I NEED VERSION 18 OF THE VA FILEMAN!" G Q
GO ;
 W !,"I HAVE TO RUN A PRE-INITIALIZATION ROUTINE." D PKG,^PSJPRE4I Q:'$D(DIFQ)  I DIFROM(0)>0 D NOW^%DTC S $P(^DIC(9.4,DIFROM(0),"PRE"),U,2)=%
EN ; ENTER HERE TO BYPASS THE PRE-INIT PROGRAM
 S DIFQ=0 D ^PSJ4INI0 W !,"I AM GOING TO SET UP THE FOLLOWING FILES:" F I=1:2:22 S DIF(I)=^UTILITY("DIF",$J,I) D 1 G Q:DIFQ!$D(DIRUT) K DIF(I)
 S DIFROM=3.2 D PKG:'$D(DIFROM(0)),^PSJ4INI1 G Q:'$D(DIFQ) S DIK(0)="B"
 F DIF=1:2:22 S %=^UTILITY("DIF",$J,DIF),DIK=$P(%,";",5),N=$P(%,";",3),D=$P(%,";",4)_U_N D D K DIFQ(N)
 K DIFQR D ^PSJ4INI2,^PSJ4INI3
 L  S DUZ=DIDUZ W !,"NO"_$P("TE THAT FILE",U,DSEC)_" SECURITY-CODE PROTECTION HAS BEEN MADE" D ^PSJPRE4P
 I DIFROM F DIF=1:2:22 S %=^UTILITY("DIF",$J,DIF),N=+$P(%,";",3) I N,$P(%,";",8)="y" S ^DD(N,0,"VR")=DIFROM
 S:DIFROM(0)>0 ^DIC(9.4,DIFROM(0),"VERSION")=DIFROM G Q^DIFROM0
D S:$D(^DIC(+N,0))[0 ^(0)=D S X=$D(@(DIK_"0)")),^(0)=D_U_$S(X#2:$P(^(0),U,3,9),1:U)
 S DIFQR=DIFQR(+N) I ^DD("VERSION")>17.5,$D(^DD(+N,0,"DIK"))#2 S X=^("DIK"),Y=+N,DMAX=^DD("ROU") D EN^DIKZ
 I DIFQR D IXALL^DIK:$O(@(DIK_"0)")) W "."
 Q
R G REP^PSJ4INI2
 ;
1 S N=+$P(DIF(I),";",3),DIF=$P(DIF(I),";",4),S=$P(DIF(I),";",5)
 W !!?3,N,?13,DIF,$P("  (Partial Definition)",U,$P(DIF(I),";",6)),$P("  (including data)",U,$P(DIF(I),";",13)="y") S Z=$S($D(^DIC(N,0))#2:^(0),1:"")
 I Z="" S DIFQ(N)=1 G S
 I $L($P(Z,DIF)) W *7,!,"*BUT YOU ALREADY HAVE '",$P(Z,U),"' AS FILE #",N,"!" D R Q:DIFQ  G S:$D(DIFKEP(N)),1
 S DIFQ(N)=$P(DIF(I),";",7)="y"
 I $L(Z) W *7,!,"Note:  You already have the '",$P(Z,U),"' File." S DIFQ(0)=1
 S %=$E(^UTILITY("DIF",$J,I+1),4,245) I %]"" X % S DIFQ(N)=$T G S
 I $L(Z),$P(DIF(I),";",10)="y" S DIR("A")="Shall I write over the existing Data Definition",DIR("??")="^D DD^DIFROMH1",DIR("B")="YES",DIR(0)="Y" D ^DIR S DIFQ(N)=Y
S S DIFQR(N)=0 Q:$P(DIF(I),";",13)'="y"!$D(DIRUT)
 I $P(DIF(I),";",15)="y",$O(@(S_"0)"))>0 S DIF=$P(DIF(I),";",14)="o",DIR("A")="Want my data "_$P("merged with^to overwrite",U,DIF+1)_" yours",DIR("??")="^D DTA^DIFROMH1",DIR(0)="Y" D ^DIR S DIFQR(N)=$S('Y:Y,1:Y+DIF) Q
 S %=$P(DIF(I),";",14)="o" W !,*7,"I will ",$P("MERGE^OVERWRITE",U,%+1)," your data with mine." S DIFQR(N)=%+1
 Q
Q W *7,!!,"NO UPDATING HAS OCCURRED!" G Q^DIFROM0
 ;
PKG S X=$P($T(IXF),";",3),DIC="^DIC(9.4,",DIC(0)="",DIC("S")="I $P(^(0),U,2)="""_$P(X,U,2)_"""",X=$P(X,U) D ^DIC S DIFROM(0)=+Y K DIC
 Q
 ;
IXF ;;INPATIENT MEDS V4 PRE-RELEASE^PSJ4;3

PSJDEA
PSJDEA ; Albany ISC/XAK,MJK, B'ham ISC/CML3 - HELP TEXT FOR DEA FIELD IN DRUG FILE ;10/1/91  12:22 [ 01/03/2002  10:39 AM ]
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 ;;3.2;;**28** Original VA Patch 28
 N %,%Y,X,Y
 W !,"The special handling code is 1 to 6 characters.  If applicable, the schedule",!,"code must appear in the first position.  For example, a schedule 3 narcotic",!,"would be coded as '3A' and a schedule 2 depressant would be coded as '2L'."
 W ! F  S %=2 W !,"Would you like a list of the codes" D YN^DICN Q:%  W !!,"Answer 'YES' to view a list of the available codes.",!
 I %=1 W ! F X=1:1 S Y=$P($T(L+X),";",3,99) Q:Y=""  W !?10,Y
 W ! Q
 ;
L ; list of codes
 ;;0          MANUFACTURED IN PHARMACY
 ;;1          SCHEDULE 1 ITEM
 ;;2          SCHEDULE 2 ITEM
 ;;3          SCHEDULE 3 ITEM
 ;;4          SCHEDULE 4 ITEM
 ;;5          SCHEDULE 5 ITEM
 ;;6          LEGEND ITEM
 ;;9          OVER-THE-COUNTER
 ;;L          DEPRESSANTS AND STIMULANTS
 ;;A          NARCOTICS AND ALCOHOLICS
 ;;P          DATED DRUGS
 ;;I          INVESTIGATIONAL DRUGS
 ;;M          BULK COMPOUND ITEMS
 ;;C          CONTROLLED SUBSTANCES - NON NARCOTIC
 ;;R          RESTRICTED ITEMS
 ;;S          SUPPLY ITEMS
 ;;B          ALLOW REFILL (SCHEDULE 3, 4, 5 NARCOTICS ONLY)
 ;;W          NOT RENEWABLE
 ;;
 ;
EDIT ;
 I X["B",X<3!(X'["A") W !,"  The B designation is only valid for schedule 3, 4, and 5 narcotics!",*7 K X Q
 Q

PSJPRE4
PSJPRE4 ; B'ham ISC/CML3 - CREATE PRIMARY DRUGS ;4/22/92  23:52  [ 01/04/2002  2:17 PM ]
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 ;;3.2;;**28** Original VA Patch 28
 ;
ENPD ; set up primary drugs
 W @IOF,!?28,"PRIMARY DRUG CONVERSION"
 W !!?2,"This option will allow you to manually create PRIMARY DRUGS and tie them to",!,"dispense drugs.",!!,"  Primary drugs are to be used by non-pharmacy personnel when ordering",!,"medications for patients.  Primary drugs"
 W " DO NOT have a strength or dose form as",!,"part of their name.",!!,"  This option will show only those dispense drugs that have not been tied to a",!,"primary drug through the auto-create option.",!
 K DIR S DIR(0)="E" D ^DIR I 'Y G PDONE
 S (PSJPRE4,Q3,QUIT,START)="" W !!,"...searching..." ; $P($G(^PS(59.7,1,20)),U,12)
 ; I $O(^PSDRUG("B",START))="" W !!,"The PRIMARY DRUG conversion process has been completed.",! G PDONE
 F CNT=0:1 S (Q3,START)=$O(^PSDRUG("B",START)) Q:START=""  W:'(CNT#100) "." D PGET Q:QUIT
 W !!,"...Primary Drug conversion ",$S(QUIT:"abort",1:"complet"),"ed!" I 'QUIT D NOW^%DTC S $P(^PS(59.7,1,20),"^",12)=%
 ;
PDONE ;
 K CNT,DIR,DIRUT,FQ,ND,ND2,NDI,PD,PDI,PDIN,PDN,PDNF,PDSH,PDU,PDX,PDY,PSJPRE4,Q1,Q2,Q3,Q4,QUIT,START D ENKV^PSGSETU Q
 ;
PDS ;
 Q:$S('+NDI:0,DT'>+NDI:0,1:1)  ;IHS/ITSC/ENM/POC 01/04/2002
 ;Q:+NDI<DT ;IHS/ITSC/ENM 01/04/2002
 S PD=PD+1,PD(PD)=Q4_"^"_$P(ND,"^")_"^"_$P(ND2,"^",3)_"^"_$P(ND,"^",9)_"^"_+NDI_"^"_+$P(ND,"^",3) Q
 ;
PDSS ;
 K DIC S X=PDX,PDX=$O(^PS(50.3,PDY,1,"B",PDX,0))
 I 'PDX,'$D(^PS(50.3,PDY,1,0)) S $P(^PS(50.3,PDY,1,0),"^",2)=$P(^DD(50.3,1,0),"^",2)
 I 'PDX K DA,DIC,DO S DA(1)=PDY,DIC="^PS(50.3,"_PDY_",1,",DIC(0)="LM",DLAYGO=50.31 S:'PDNF!'PDIN DIC("DR")=$S('PDNF:".02////1",1:"")_$E(";",'PDNF&'PDIN)_$S('PDIN:".03////"_DT,1:"") D FILE^DICN Q
 Q:'PDNF&'PDIN  S Y=$G(^PS(50.3,PDY,1,PDX,0)),X=$S(PDNF:$P(Y,"^",2),1:0),Y=$S(PDIN:$P(Y,"^",3),1:0) I X!Y S DIE="^PS(50.3,"_PDY_",1,",DA(1)=PDY,DA=PDX,DR=$S(X:".02//@"_$E(";",Y),1:"")_$S(Y:".03///"_DT,1:"") D ^DIE
 Q
 ;
PGET ;
 ;IHS/ITSC/ENM 11/26/01 NEXT LINE COPIED/MODIFIED
 K PD S PD=0 F Q4=0:0 S Q4=$O(^PSDRUG("B",START,Q4)) Q:'Q4  S ND=$G(^PSDRUG(Q4,0)),ND2=$G(^(2)) I $S($P(ND,U)="":0,$P(ND2,U,6):0,$P(ND2,U,3)["U":1,1:$P(ND2,U,3)["I") S NDI=$G(^("I")) D PDS
 S Q1=START,Q2=$P(Q1," "),Q4=""
 F  S Q1=$O(^PSDRUG("B",Q1)) Q:Q1=""  Q:$P(Q1," ")'=Q2  S Q3=Q1 F  S Q4=$O(^PSDRUG("B",Q1,Q4)) Q:'Q4  S ND=$G(^PSDRUG(Q4,0)),ND2=$G(^(2)) I $P(ND,U)]"",'$P(ND2,U,6),$P(ND2,U,3)["U"!($P(ND2,U,3)["I") S NDI=$G(^("I")) D PDS
 I 'PD S START=Q3 Q
 ;
PSHOW ;
 W @IOF,! F Q=1:1:PD W !,$J(Q,3,0),". ",$P(PD(Q),U,2) ; W:$P(PD(Q),"^",4) "    N/F"
 S %=1 I PD>1 F  W !!,"Can these drugs all be given the same primary drug" S %=1 D YN^DICN Q:%  D PSH^PSJPRE4H
 I %<0 S QUIT=1 Q
 I %=2 D PSEL G:$D(DIRUT) PSHOW
 ;
PS ;
 W !!,"Select a PRIMARY DRUG for ",$S(PD=1:"this drug",$L($P(PD,U,2),",")=1:"this drug",1:"these drugs")_": " R X:DTIME W:'$T *7 S:'$T X=U I X=U S QUIT=1 Q
 I X="" W !!?5,"This is a required response.  Enter '^' to exit." G PS
 I X?1."?" W !!?2,"Select a name for a primary drug that will be tied to the listed drugs.  The",!,"name selected can be a new entry or an entry already entered for other drugs."
 I  W !?2,"THE PRIMARY DRUG MUST BE NAME ONLY, NO DOSAGE!",!?2,"PLEASE BE SURE OF YOUR SPELLING!",!
 K DIC S DIC="^PS(50.3,",DIC(0)="ELMQZ",DIC("S")="I $S($D(^(1,""B"",""U"")):1,1:$D(^(""I"")))",DLAYGO=50.3 D ^DIC
 G:Y'>0 PS S PDN=$P(Y,U,3),PDY=+Y,(PDI,PDIN,PDNF,PDSH,PDU)=0 I '$D(^PS(50.3,PDY,1,0)) S ^(0)="^50.31"
 S %=1 I 'PDN S Q=Y(0,0) F  W !!,"Is ",Q," ok" S %=1 D YN^DICN Q:%  W !!?2,"Answer 'YES' if the primary drug shown is the primary drug you wanted.  Answer",!,"'NO' to select another primary drug."
 G:%'=1 PS K DA,DR S DIE="^PSDRUG(",DR="64////"_+Y I PD=1 S DA=+PD(1),PDSH=$P(PD(1),"^",6) D ^DIE S:$P(PD(1),"^",3)["U" PDU=1 S:$P(PD(1),"^",3)["I" PDI=1 S:'$P(PD(1),"^",4) PDNF=1 S:'$P(PD(1),"^",5) PDIN=1
 I PD>1,'$P(PD,U,2) F FQ=1:1:PD S DA=+PD(FQ) D ^DIE S:$P(PD(FQ),"^",3)["U" PDU=1 S:$P(PD(FQ),"^",3)["I" PDI=1 S:'$P(PD(FQ),"^",4) PDNF=1 S:'$P(PD(FQ),"^",5) PDIN=1 S:FQ=1 PDSH=$P(PD(FQ),"^",6) W "." I FQ>1,PDSH,PDSH'=$P(PD(FQ),"^",6) S PDSH=0
 I PD>1,$P(PD,U,2)
 I  F FQ=1:1 S ND=$P($P(PD,U,2),",",FQ) Q:'ND  S:$P(PD(ND),U,3)["U" PDU=1 S:$P(PD(ND),U,3)["I" PDI=1 S DA=+PD(ND) S:'$P(PD(ND),U,4) PDNF=1 S:'$P(PD(ND),U,5) PDIN=1 D ^DIE S:FQ=1 PDSH=$P(PD(ND),U,6) W "." I FQ>1,PDSH,PDSH'=$P(PD(ND),U,6) S PDSH=0
 I PDU S PDX="U" D PDSS
 I PDI S PDX="I" D PDSS
 I PDSH S:PDN $P(^PS(50.3,PDY,0),"^",2)=PDSH I 'PDN S X=$P(^PS(50.3,PDY,0),"^",2) I X,X'=PDSH S $P(^(0),"^",2)=""
 I $S(PD=1:1,1:'$P(PD,U,2)) S START=Q3 Q
 G PGET
 ;
PSEL ;
 K DIR S DIR(0)="LA^1:"_PD,DIR("A")="Select DRUGS TO TIE A PRIMARY DRUG: ",DIR("?")="^D PSELH^PSJPRE4H" W ! D ^DIR
 I '$D(DIRUT),Y>0,$L(Y,",")-1'=PD S $P(PD,U,2)=$E(Y,1,$L(Y)-1)
 Q

PSJPRE40
PSJPRE40 ; B'ham ISC/CML3 - PRIMARY DRUG/DISPENSE DRUG REPORT ;4/23/92  00:19 [ 01/03/2002  10:40 AM ]
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 ;;3.2;;**28** Original VA Patch 28
 ;
 W @IOF,!!?23,"PRIMARY DRUG/DISPENSE DRUG REPORT"
 W !!?2,"This report will show the dispense drugs (entries from the Drug file) that",!,"have been tied to a primary drug.  You can have this report sort by primary",!,"drug or dispense drug.  You can also show exceptions at the end of the"
 W " report.",!,"(Exceptions are dispense drugs that have not yet been tied to a primary drug.)"
 K DIR S DIR(0)="S^1:Only dispense drugs tied to a primary drug;2:Only dispense drugs not tied to a primary drug;3:All dispense drugs",DIR("A")="Show which dispense drugs",DIR("B")="All dispense drugs",DIR("?")="^D H1^PSJPRE40"
 W ! D ^DIR G:'Y DONE S SD=Y S:SD=2 RS=2
 I SD'=2 K DIR S DIR(0)="S^1:Primary Drug;2:Dispense Drug",DIR("A")="Sort the report by",DIR("B")="Primary Drug",DIR("?")="^D H2^PSJPRE40" W ! D ^DIR G:'Y DONE S RS=Y
 K %ZIS,IO("Q"),IOP S %ZIS="Q",%ZIS("A")="Select PRINT DEVICE: " W ! D ^%ZIS I POP W !!?3,"No device selected, or report run." G DONE
 I $D(IO("Q")) K ZTSAVE,ZTDTH S ZTRTN="DQ^PSGTI",PSGTIR="ENQ^PSJPRE40" S (ZTSAVE("SD"),ZTSAVE("RS"),ZTSAVE("PSGTIR"))="" D ^%ZTLOAD W !!?3,"Report ",$S($D(ZTSK):"",1:"NOT "),"queued!" G DONE
 W !!,"A few moments, please...."
 ;
ENQ ;
 S CML=IO'=IO(0)!($E(IOST)'="C") K ^TMP($J) S (NP,Q)=0 F  S Q=$O(^PSDRUG(Q)) Q:'Q  S ND2=$G(^(Q,2)) I $P(ND2,"^",3)["U"!($P(ND2,"^",3)["I") S DN=$P($G(^(0)),"^") D NSET I 'CML S NP=NP+1 I '(NP#100) W "."
 ;
PRINT ;
 U IO D NOW^%DTC S %=%_"000000",HDT=$E(%,4,5)_"/"_$E(%,6,7)_"/"_$E(%,2,3)_" "_$E(%,9,10)_":"_$E(%,11,12),(NP,PG)=0,HDRC="" D HDR
 I RS=2 S DN="" F  S DN=$O(^TMP($J,DN)) Q:DN=""  S PN=^(DN) D:$Y+$S(SD'=2:4,1:7)>IOSL NP Q:NP  W:SD'=2 ! W !?1,DN I SD'=2 W !?10,$S(PN'="zz":PN,1:"** NO PRIMARY DRUG FOUND **")
 I 'NP,RS=1 S (DN,PN)="" F  S PN=$O(^TMP($J,PN)) Q:PN=""  Q:PN="zz"  Q:NP  S HDRC="" D:$Y+6>IOSL NP Q:NP  W !!?1,PN S HDRC=PN F  S DN=$O(^TMP($J,PN,DN)) Q:DN=""  D:$Y+4>IOSL NP Q:NP  W !?10,DN
 I 'NP,RS=1,PN="zz" D:$Y+4>IOSL NP I 'NP W !!,"** EXCEPTIONS **" S HDRC="** EXCEPTIONS **" F  S DN=$O(^TMP($J,PN,DN)) Q:DN=""  D:$Y+4>IOSL NP Q:NP  W !?10,DN
 W !!!?29,"*** REPORT ",$S('NP:"FINISHED",1:"ABORTED")," ***" W:CML @IOF D ^%ZISC
 ;
DONE ;
 K CML,DN,HDT,ND2,NP,PD,PG,PN,RS,SD D ENKV^PSGSETU Q
 ;
NSET ;
 I DN="" S DN=Q_";PSDRUG("
 S PD=$P(ND2,"^",6) I SD=2 S:'PD ^TMP($J,DN)="" Q
 I SD=1,'PD Q
 S PN=$S('PD:"zz",1:$P($G(^PS(50.3,PD,0)),"^")) S:PN="" PN=PD_";PS(50.3,"
 I RS=2 S ^TMP($J,DN)=PN Q
 S ^TMP($J,PN,DN)="" Q
 ;
NP ;
 I 'CML K DIR S DIR(0)="E" W ! D ^DIR S NP='Y Q:NP
 ;
HDR ;
 S PG=PG+1 W @IOF,!!?1,HDT,?23,"PRIMARY DRUG/DISPENSE DRUG REPORT",?73-$L(PG),"Page: ",PG,!
 I PG=1 W !,"--------------------------------------------------------------------------------"
 I  W !,"This report was run to show ",$S(SD=1:"only dispense drugs tied to a primary drug",SD=2:"only dispense drugs not tied to a primary drug",1:"all dispense drugs"),"," W:SD=2 ! W:SD'=2 " " W "sorted" W:SD=1 ! W:SD'=1 " "
 I  W "by ",$S(RS=1:"primary",1:"dispense")," drug."
 I  W !,"--------------------------------------------------------------------------------"
 W !?1,$S(RS=1:"Primary",1:"Dispense")," Drug" I $S(RS=1:1,1:SD'=2) W !?10,$S(RS=1:"Dispense Drug",1:"Primary Drug")
 W !,"-------------------------------------------------------------------------------"
 I HDRC]"" W !,HDRC,"  (cont.)"
 Q
 ;
H1 ;
 W !!?2,"Select which dispense drugs you wish to print.  Answer '1' to print only those",!,"dispense drugs that have already been tied to a primary drug.  Answer '2' to",!,"print only those dispense drugs that have not yet been tied to a"
 W " primary drug.",!,"Answer '3' to print all dispense drugs." Q
 ;
H2 ;
 W !!?2,"Answer '1' to have this report sort bt primary drug, that is, group the",!,"dispense drugs by primary drug.  Answer '2' to have this report sort by",!,"dispense drug." Q
 ;
ENDTC(Y) ;
 I '$G(Y) Q "NOT FOUND"
 S Y=Y_"000" Q $E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)_"  "_$E(Y,9,10)_":"_$E(Y,11,12)

PSJPRE41
PSJPRE41 ; B'ham ISC/MLM,CML3 - EDIT UTILITIES ;4/22/92  23:58 [ 01/03/2002  10:40 AM ]
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 ;;3.2;;**28** Original VA Patch 28
 ;
ENADDT ; Edit IV Additive Type only
 K DA,DIC,DIE,DR F  S DIC=52.6,DIC(0)="AEQM" D ^DIC Q:Y<0  S DA=+Y,DIE=DIC,DR=15 D ^DIE
 ;
QUIT ;
 K C,I,PSIV D ENKV^PSGSETU
 Q
ENSOLT ; Edit IV Solution USED IN IV FLUID ORDER ENTRY only
 K DA,DIC,DIE,DR F  S DIC=52.7,DIC(0)="AEQM",DIC("S")="I $P(^(0),U,4)=""""" D ^DIC Q:Y<0  S DA=+Y,DIE=DIC,DR=9 D ^DIE
 G QUIT
 Q
 ;
ENE ; edit primary drug fields, including unit dose fields
 F  K DIC S DIC="^PS(50.3,",DIC(0)="AELMQ",DLAYGO=50.3 W ! D ^DIC Q:Y'>0  D EPD
 K DLAYGO G QUIT
 ;
ENALU ; application look-up
 N PSJ S PSJ=DA(1) N DA,DIC,DIE,DIX,DO,DR S DIC="^PS(50.35,",DIC(0)=$E("E",'$D(PSJPRE4))_"IMZ" D DO^DIC1,^DIC I Y'>0 K X Q
 S X=$P(Y(0),"^",2) K:$S(X="":1,1:$D(^PS(50.3,PSJ,1,"B",X))) X Q
 ;
ENAQ ; application query
 S X=DZ N DA,DIC,DIE,DO,DR,DZ S DIC="^PS(50.35,",DIC(0)="EIMQ" D DO^DIC1,^DIC Q
 ;
EPD ;
 K DA,DR S DA=+Y,DIE="^PS(50.3,",DR=".01;.02;.03;2;W !!,""(Package specific fields)"",$C(58);1",DR(2,50.31)=".02;.03;.05;.06;.07;.08;S:'$P(^PS(50.3,DA(1),1,DA,0),""^"",2) Y="""";1" W !!,"(Primary Drug fields):" D ^DIE
 Q
 ;
ENDDE ; edit the primary drug field in the drug file
 F  K DIC S DIC="^PSDRUG(",DIC(0)="AEMQ",DIC("A")="Select DISPENSE DRUG: ",DIC("S")="S X(1)=$P($G(^(2)),""^"",3) I X(1)[""U""!(X(1)[""I"")" W ! D ^DIC Q:Y'>0  S DIE=DIC,DA=+Y,DR=64 W ! D ^DIE
 G QUIT
 ;
ENEUP ; edit user parameters
 F  K DIC S DIC="^PS(53.45,",DIC(0)="AELQZ",DIC("A")="Select INPATIENT USER: ",DLAYGO=50.3,D="B" W ! D IX^DIC Q:Y'>0  K DA,DR S DA=+Y,DIE=DIC,DR="[PSJ4 EUP]",IU=+Y(0) D  W ! D ^DIE
 .F X=1:1:3 I $D(^XUSEC("PSJ "_$P("RPHARM^RNURSE^PHARM TECH","^",X),IU)) Q
 .S:'$T X=0 S R=$G(^VA(200,IU,"PS")),R=$S('R:0,'$P(R,"^",4):1,1:$P(R,"^",4)>DT)
 .W !!,"This user is a " W:X $P("PHARMACIST^NURSE^PHARMACY TECHNICIAN","^",X) W:'X&'R "WARD CLERK" W:'R "." I R W:X " and a " W "PROVIDER."
 K IU G QUIT
 ;
ENSYN ; move trade names from 50 to 50.3
 D ENSYNMSG^PSJPRE4H K DIR S DIR(0)="E" D ^DIR K DIR I 'Y W !!?3,"Trade Name move aborted." K X,Y Q
 S (CNT,PSJD)=0 W !!,"Moving trade names..."
 F  S PSJD=$O(^PSDRUG(PSJD)) Q:'PSJD  S PSJPD=$P($G(^(PSJD,2)),"^",6) I PSJPD,$O(^(1,0)) S SYN=0 F  S SYN=$O(^PSDRUG(PSJD,1,SYN)) Q:'SYN  S SYNN=$G(^(SYN,0)) I $P(SYNN,"^")]"",$P(SYNN,"^",3)=0,'$D(^PS(50.3,PSJPD,2,"B",$P(SYNN,"^"))) D  ;
 .I $D(^PS(50.3,PSJPD,2,0))[0 S $P(^PS(50.3,PSJPD,2,0),"^",2)=$P(^DD(50.3,2,0),"^",2)
 .K DA S DA(1)=PSJPD,DIC="^PS(50.3,"_PSJPD_",2,",DIC(0)="LM",DLAYGO=50.32,X=$P(SYNN,"^") D FILE^DICN I Y>0 S CNT=CNT+1 W:'(CNT#25) "."
 K CNT,DA,DIC,DLAYGO,PSJP,PSJPD,SYN,SYNN,X,Y G QUIT
 ;
ENTOUR ; type of user report
 K %ZIS S %ZIS="Q",%ZIS("A")="Select PRINT DEVICE: ",%ZIS("B")="" D ENTOUMSG^PSJPRE4H,^%ZIS I POP D HOME^%ZIS W !!?3,"No device selected; report aborted." G QUIT
 I $D(IO("Q")) K ZTSAVE,ZTDTH S ZTRTN="ENQTOU^PSJPRE41" D ^%ZTLOAD W !!,"Type of User report ",$S($D(ZTSK):"",1:"NOT")," queued." G QUIT
 ;
ENQTOU ;
 D NOW^%DTC S PDT=$$ENDTC^PSJPRE40(%),DT=$P(%,"."),PG=0,CML=IO'=IO(0)!($E(IOST)'="C") U IO D TOUHDR
 S (N,Y)="" F  S N=$O(^VA(200,"B",N)) Q:N=""  S P=0 F  S P=$O(^VA(200,"B",N,P)) Q:'P  S TD=$P($G(^VA(200,P,0)),"^",11) I $S('TD:1,1:DT>TD) S R=$G(^VA(200,P,"PS")) D  G:Y TOUDONE
 .I $Y+4>IOSL D TOUNP Q:Y
 .S T=$S($D(^XUSEC("PSJ RPHARM",P)):3,$D(^XUSEC("PSJ RNURSE",P)):2,$D(^XUSEC("PSJ PHARM TECH",P)):1,1:0),R=$S('R:0,'$P(R,"^",4):1,1:DT'>$P(R,"^",4)) Q:'T&'R
 .W !,$P(N,"^"),?45,$P("^PHARMACY TECHNICIAN^NURSE^PHARMACIST","^",T+1) W:R ?65,"PROVIDER"
 W !!?33,"END OF REPORT" W:CML @IOF
 ;
TOUDONE ;
 D ^%ZISC K N,P,PDT,PG,R,T,TD G QUIT
 ;
TOUNP ;
 S Y=1 I 'CML K DIR S DIR(0)="E" W ! D ^DIR Q:'Y
 ;
TOUHDR ;
 S PG=PG+1 W @IOF,!!?24,"INPATIENT NEW PERSON USER REPORT",?64,PDT,!!,"Name",?45,"Type of User",!,"-------------------------------------------------------------------------------"
 Q

PSJPRE42
PSJPRE42 ; B'ham ISC/CML3 - MOVE SITE PARAMETERS ;2/18/92  16:56 [ 01/03/2002  10:41 AM ]
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 ;;3.2;;**28** Original VA Patch 28
 ;
 W @IOF,!?18,"MOVE SITE PARAMETERS TO WARD PARAMETER FILE"
 W !!?2,"This option is designed to allow you to seed the Inpatient Ward Parameter file",!,"with data from the Inpatient Site Parameter file.  After the ward list is built,",!,"select the Inpatient site from which you want to move data.  Then"
 W " select the",!,"ward(s) which you want to seed with the site data.  The data from the selected",!,"Inpatient site will then be moved to each ward selected.",!!,"BUILDING the ward list..."
 D BWL
 I 'PSG F  W !!,"The data move has already been completed.",!,"Would you like to edit any of the entries in the Ward Parameter file" S %=0 D YN^DICN Q:%  W !!?2,"Enter 'YES' to edit the Ward Parameter file.  Enter 'NO' to exit this option."
 I 'PSG G:%=1 ENWE G DONE
 ;
IS ;
 S DIC="^PS(59.4,",DIC(0)="AEMQZ" W ! D ^DIC I Y'>0 G DONE
 S IS=+Y,ISND=Y(0) F Q=1,2,5,6,10,12,13,14,15,16,17,18,19,20,21,22,23,25,26,27,28,29,30 S $P(ISND,"^",Q)=""
 ;
 S DIR(0)="LAO^1:"_PSG,DIR("A")="Select WARD(S) (1-"_PSG_"): ",DIR("?")="^D WH^PSJPRE42" W ! D ^DIR G:'Y IS
 W !!,"Working..." F Q1=0:1 Q:'$D(Y(Q1))  F Q2=1:1 S X=$P(Y(Q1),",",Q2) Q:'X  D WS
 D BWL G:PSG IS F  W !!,"The data move has been completed to all wards.",!,"Would you like to edit any of the wards" S %=0 D YN^DICN Q:%  W !!?2,"Enter 'YES' to edit the Ward Parameter file.  Enter 'NO' to exit this option."
 G:%=1 ENWE G DONE
 ;
BWL ; build ward list
 K PSG S (PSG,Q)=0
 F  S Q=$O(^DIC(42,Q)) Q:'Q  I '$D(^PS(59.6,"B",Q)) S X=$G(^DIC(42,Q,0)),PSG=PSG+1,PSG(PSG)=Q_"^"_$P(X,"^")
 Q
 ;
WH ;
 W !!?2,"Select the ward(s) to which you want to move the data from the selected",!,"Inpatient site.  Choose, by number, from the following wards:"
 S Q=0 F  S Q=Q+1 Q:Q>PSG  W !,$J(Q,3),". ",$P(PSG(Q),"^",2) S Q=Q+1 Q:Q>PSG  W ?26,$J(Q,3),". ",$P(PSG(Q),"^",2) S Q=Q+1 Q:Q>PSG  W ?52,$J(Q,3),". ",$P(PSG(Q),"^",2)
 Q
 ;
WS ;
 N Y S X=+PSG(X),$P(ISND,"^")=X,DIC="^PS(59.6,",DIC(0)="L",DLAYGO=59.6 W "." D ^DIC W "." I Y>0 S ^PS(59.6,+Y,0)=ISND,DA=+Y,DIK=DIC D IX1^DIK
 Q
 ;
ENWE ;
 K DA,DIC,DIE,DR F  S DIC="^PS(59.6,",DIC(0)="AEMQ" W ! D ^DIC Q:Y'>0  S DA=+Y,DIE=DIC,DR=".03;.04;.07;.08;.15;.12;.13;.16;.14;.11;.24" D ^DIE
 ;
DONE ;
 D ENKV^PSGSETU K IS,ISND,PSG,Q1,Q2 Q
 ;
ENDL ; device look-up
 N DA,DIC,DIE,DIX,DO,DR
 S DIC="^%ZIS(1,",DIC(0)="EIMZ" D DO^DIC1,^DIC I Y'>0 K X Q
 S X=Y(0,0) Q
 ;
ENDH(X) ; device help
 N DA,DIC,DIE,DO,DR,DZ
 S DIC="^%ZIS(1,",DIC(0)="EIM" D DO^DIC1,^DIC Q

PSJPRE43
PSJPRE43 ; B'ham ISC/CML3 - MOVE PICK LIST PARAMETERS ;9/4/91  18:30 [ 01/03/2002  10:41 AM ]
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 ;;3.2;;**28** Original VA Patch 28
 ;
 W @IOF,!?18,"MOVE PICK LIST PARAMETERS TO WARD GROUP FILE"
 W !!?2,"This option is designed to allow you to seed the Inpatient Ward Group file",!,"with the PICK LIST data from the Inpatient Site Parameter file.  After the ward",!,"group list is built, select the Inpatient site from which you want to"
 W " move the",!,"pick list data.  Then select the ward group(s) which you want to seed with the",!,"pick list data.  The pick list data from the selected Inpatient site will then",!,"be moved to each ward group selected."
 W !!,"BUILDING the ward group list..." D BWL
 I 'PSG F  W !!,"The data move has already been completed.",!,"Would you like to edit any of the entries in the Ward Group file" S %=0 D YN^DICN Q:%  W !!?2,"Enter 'YES' to edit the Ward Parameter file.  Enter 'NO' to exit this option."
 I 'PSG G:%=1 ENWE G DONE
 ;
IS ;
 K DIC S DIC="^PS(59.4,",DIC(0)="AEMQZ",DIC("S")="I $G(^(5))]""""" W ! D ^DIC I Y'>0 G DONE
 S IS=+Y,ISND=$G(^PS(59.4,IS,5))
 ;
 S DIR(0)="LAO^1:"_PSG,DIR("A")="Select WARD GROUP(S) (1-"_PSG_"): ",DIR("?")="^D WH^PSJPRE43" W ! D ^DIR G:'Y IS
 W !!,"Working..."
 F Q1=0:1 Q:'$D(Y(Q1))  F Q2=1:1 S X=$P(Y(Q1),",",Q2) Q:'X  S ^PS(57.5,+PSG(X),5)=ISND
 D BWL G:PSG IS F  W !!,"The data move has been completed to all wards.",!,"Would you like to edit any of the ward groups" S %=0 D YN^DICN Q:%  W !!?2,"Enter 'YES' to edit the Ward Parameter file.  Enter 'NO' to exit this option."
 G:%=1 ENWE G DONE
 W !,"Working..."
 ;
BWL ; build ward list
 K PSG S (PSG,Q)=0
 F  S Q=$O(^PS(57.5,Q)) Q:'Q  S X=$G(^(Q,0)) I $P(X,"^",2)="P",'$D(^(5)) S PSG=PSG+1,PSG(PSG)=Q_"^"_$P(X,"^")
 Q
 ;
WH ;
 W !!?2,"Select the ward group(s) to which you want to move the pick list data from",!,"the selected Inpatient site.  Choose, by number, from the following ward",!,"groups:"
 S Q=0 F  S Q=Q+1 Q:Q>PSG  W !,$J(Q,3),". ",$P(PSG(Q),"^",2) S Q=Q+1 Q:Q>PSG  W ?26,$J(Q,3),". ",$P(PSG(Q),"^",2) S Q=Q+1 Q:Q>PSG  W ?52,$J(Q,3),". ",$P(PSG(Q),"^",2)
 Q
 ;
ENWE ;
 F  S DIC="^PS(57.5,",DIC(0)="AEMQ",DIC("S")="I $P($G(^(0)),U,2)=""P""" W ! D ^DIC Q:Y'>0  S DA=+Y,DIE=DIC,DR="5.02;5.03;S:X Y=""@3"";5.01;@3;5.04;S:X Y=""@5"";5.05;@5;S %=$G(^PS(57.5,DA,5)) S:$S($P(%,U,4):1,1:'$P(%,U,5)) Y="""";5.06" W ! D ^DIE
 ;
DONE ;
 D ENKV^PSGSETU K IS,ISND,PSG,Q1,Q2 Q

PSJPRE44
PSJPRE44 ; B'ham ISC/CML3 - PRINT OUT INPATIENT SITE FILE ;3/23/92  18:42 [ 01/03/2002  10:41 AM ]
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 ;;3.2;;**28** Original VA Patch 28
 ;
 W @IOF,!?30,"INPATIENT SITE PRINT"
 W !!?2,"This option will print all of the information contained in each of the entries",!,"in your Inpatient Site file, to assist you in your decisions in moving data",!,"from the Inpatient Site file to the Inpatient Ward Parameter file and "
 W !,"the Ward Group file.",!!?2,"Although this can be printed to your screen, it is highly recommended that",!,"you send this print to a printer so that you can have a hard copy readily",!,"available when using the data move options.",!
 ;
 K %ZIS,IO("Q"),IOP S %ZIS="Q",%ZIS("A")="Select PRINTER FOR INPATIENT SITE LIST: ",%ZIS("B")="" D ^%ZIS I POP D HOME^%ZIS G DONE
 I $D(IO("Q")) K ZTSAVE S ZTDTH=$H,PSGTIR="ENQ^PSJPRE44",ZTRTN="DQ^PSGTI",ZTSAVE("PSGTIR")="" D ENTSK^PSGTI W !?3,"...print ",$S($D(ZTSK):"",1:"NOT "),"sent..." G DONE
 ;
ENQ ;
 D NOW^%DTC S CNT=0,PG=1,PDT=$E(%,4,5)_"/"_$E(%,6,7)_"/"_$E(%,2,3),CML=IO'=IO(0)!($E(IOST)'="C"),ND="" U IO W @IOF,!!,PDT,?28,"INPATIENT SITE FILE PRINT",?71,"Page: 1"
 F Q=0:0 S Q=$O(^PS(59.4,Q)) Q:'Q  I $S($D(^(Q,0)):1,1:$D(^(5))) D PRT Q:ND="^"
 S X="*** INPATIENT SITE PRINT "_$S(ND="^":"ABORTED",1:"COMPLETED") S:'CNT X=X_" - NO ENTRIES FOUND" S X=X_" ***" W !!?80-$L(X)/2,X W:CML @IOF D ^%ZISC
 ;
DONE ;
 D ENKV^PSGSETU K CML,CNT,ND,PDT,PG,PL,PSGTIR Q
 ;
PRT ;
 S CNT=CNT+1,ND=$G(^PS(59.4,Q,0)),PL=$G(^(5))
 D:$Y+5>IOSL&CML NP W !!,"-------------------------------------------------------------------------------",!,"Site: ",$S($P(ND,"^")]"":$P(ND,"^"),1:Q)
 D:$Y+3>IOSL&CML NP W !?4,"Days until stop date/time: ",$P(ND,"^",3),?47,"Order entry process: ",$S($P(ND,"^",21)="1":"WARD",$P(ND,"^",21)="1":"ABBREVIATED",1:"REGULAR")
 D:$Y+3>IOSL&CML NP W !?1,"Same stop date on all orders: ",$S($P(ND,"^",4):"YES",1:"NO"),?41,"'SELF MED' in order entry: ",$S($P(ND,"^",24):"YES",1:"NO")
 D:$Y+3>IOSL&CML NP W !?1,"Time of day that orders stop: ",$P(ND,"^",7),?49,"Auto nurse verify: ",$S($P(ND,"^",15):"YES",1:"NO")
 D:$Y+3>IOSL&CML NP W !?3,"Start time for 24 hour MAR: ",$P(ND,"^",8),?44,"Auto pharmacist verify: ",$S($P(ND,"^",17):"YES",1:"NO")
 D:$Y+3>IOSL&CML NP W !?9,"Days new labels last: ",$P(ND,"^",11),?44,"Pre-exchange envelopes: ",$S($P(ND,"^",27):"YES",1:"NO")
 D:$Y+3>IOSL&CML NP W !?1,"Print profile in order entry: ",$S($P(ND,"^",30):"YES",1:"NO")
 D:$Y+3>IOSL&CML NP W !,"PICK LIST:",!?6,"Room/bed sort: ",$S($P(PL,"^"):"BED-ROOM",1:"ROOM-BED"),?55,"Form feed/patient: ",$S($P(PL,"^",4):"YES",1:"NO")
 D:$Y+3>IOSL&CML NP W !?5,"Omit ward sort: ",$S($P(PL,"^",2):"YES - DO NOT SORT BY WARD",1:"NO - SORT BY WARD"),?58,"Form feed/ward: ",$S($P(PL,"^",5):"YES",1:"NO")
 D:$Y+3>IOSL&CML NP W !?1,"Omit room-bed sort: ",$S($P(PL,"^",3):"YES - DO NOT SORT BY ROOM-BED",1:"NO - SORT BY ROOM-BED"),?54,"Lines on form feed: ",$S($P(PL,"^",6):"YES",1:"NO")
 S ND="" I 'CML K DIR S DIR(0)="E" W ! D ^DIR S:X="^"!$D(DIRUT) ND="^"
 Q
 ;
NP ;
 S PG=PG+1 W @IOF,!,PDT,?30,"INPATIENT SITE FILE PRINT",?72-$L(PG),"Page: ",PG,! Q

PSJPRE45
PSJPRE45 ; B'ham ISC/CML3 - PRINT OUT DRUGS ;3/25/92  12:25 [ 01/03/2002  10:42 AM ]
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 ;;3.2;;**28** Original VA Patch 28
 ;
 W @IOF,!?32,"LOCAL DRUG PRINT"
 W !!?2,"This option will print all of the entries in your Drug file that are marked",!,"for either Unit Dose or IVs, grouped exactly as the option to manually create",!,"primary drugs will group them."
 W "  This print can then be used to determine",!,"primary drug names before actually running that option."
 W !!?2,"Although this can be printed to your screen, it is highly recommended that",!,"you send this print to a printer so that you can have a hard copy readily",!,"available when using the option to create primary drugs.",!
 ;
 K %ZIS,IO("Q"),IOP S %ZIS="Q",%ZIS("A")="Select PRINTER FOR DRUG PRINT: ",%ZIS("B")="" D ^%ZIS I POP D HOME^%ZIS W !!?3,"No device selected, or report run." G DONE
 I $D(IO("Q")) K ZTSAVE S ZTDTH=$H,PSGTIR="ENQ^PSJPRE45",ZTRTN="DQ^PSGTI",ZTSAVE("PSGTIR")="" D ENTSK^PSGTI W !?3,"...print ",$S($D(ZTSK):"",1:"NOT "),"sent..." G DONE
 ;
ENQ ;
 U IO D NOW^%DTC S PG=0,PDT=$E(%,4,5)_"/"_$E(%,6,7)_"/"_$E(%,2,3),CML=IO'=IO(0)!($E(IOST)'="C") D HDR
 S (NP,Q3,START)="" F  S (Q3,START)=$O(^PSDRUG("B",START)) Q:START=""  D PGET Q:NP="^"
 S X="*** DRUG PRINT "_$S(NP="^":"ABORTED",1:"COMPLETED")_" ***" W !!?80-$L(X)/2,X W:CML @IOF D ^%ZISC
 ;
DONE ;
 D ENKV^PSGSETU K CML,ND,ND2,NP,PDT,PG,Q1,Q2,Q3,Q4,START,PSGTIR Q
 ;
PGET ;
 K PD S PD=0 F Q4=0:0 S Q4=$O(^PSDRUG("B",START,Q4)) Q:'Q4  S ND=$G(^PSDRUG(Q4,0)),ND2=$P($G(^(2)),"^",3) I $P(ND,"^")]"",ND2["U"!(ND2["I") S PD=PD+1,PD(PD)=Q4_"^"_$P(ND,"^")_"^"_+$G(^("I"))_"^"_$P(ND,"^",9)
 S Q1=START,Q2=$P(Q1," ")
 F  S Q1=$O(^PSDRUG("B",Q1)) Q:Q1=""  Q:$P(Q1," ")'=Q2  S Q3=Q1 D  ;
 .F Q4=0:0 S Q4=$O(^PSDRUG("B",Q1,Q4)) Q:'Q4  S ND=$G(^PSDRUG(Q4,0)) I $P(ND,"^")]"" S ND2=$G(^(2)) I $P(ND2,"^",3)["U"!($P(ND2,"^",3)["I") S PD=PD+1,PD(PD)=Q4_"^"_$P(ND,"^")_"^"_+$G(^("I"))_"^"_$P(ND,"^",9)
 S START=Q3 Q:'PD  D:$Y+4>IOSL NP Q:NP="^"  W ! F ND=1:1:PD D PRT Q:NP="^"
 Q
 ;
PRT ;
 I $Y+3>IOSL D NP Q:NP="^"
 W !?2,$P(PD(ND),"^",2) W:$P(PD(ND),"^",4) ?50,"(N/F)" S Y=$P(PD(ND),"^",3) I Y W ?60,$E(Y,4,5),"/",$E(Y,6,7),"/",$E(Y,2,3)
 Q
 Q
 ;
NP ;
 I 'CML S DIR(0)="E" W ! D ^DIR S:'Y NP="^" W # Q
 ;
HDR ;
 S PG=PG+1 W @IOF,!?2,PDT,?35,"DRUG PRINT",?72-$L(PG),"Page: ",PG,!!?2,"DRUG NAME",?60,"INACTIVE DATE",!,"-------------------------------------------------------------------------------" Q

PSJPRE46
PSJPRE46 ; B'ham ISC/WRT - Report of potential Primary Drugs created; 08/27/91 14:12 ;1/8/92  10:51 [ 01/03/2002  10:42 AM ]
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 ;;3.2;;**28** Original VA Patch 28
 ;
 W @IOF,!!?25,"PRIMARY DRUG AUTO-CREATE REPORT"
 W !!?2,"This report will show the PRIMARY DRUGS that will be created by the 'auto-",!,"create option, and should be run before running the auto-create option."
 W !!?2,"PLEASE NOTE that the VA Generic Name from the National Drug File is used.",!,"If the VA Generic Drug Name is longer than 40 characters, it is not used, and",!,"the primary drug must then be created using the 'manual-create' option."
 W !!?2,"This 80 column report must be sent to a printer, and can be queued.",!
 I '$D(^PSNDF) W *7,!,"This report cannot be run because there is no National Drug File online.",! Q
DVC K IO("Q"),IO("C"),%ZIS,POP,IOP S %ZIS="QFM",%ZIS("B")="",%ZIS("A")="Select Printer: " D ^%ZIS G:POP DONE W:$E(IOST)'="P" !!,"This report must be run on a printer.",!! G:$E(IOST)'="P" DVC I POP K IOP,POP,IO("Q") Q
QUEUE I $D(IO("Q"))!$D(IO("C")) K IO("Q") S ZTRTN="ENQ^PSJPRE46" K ZTSAVE,ZTDTH,ZTSK S PSNDEV=ION_";"_IOST_";"_IOM_";"_IOSL,ZTSAVE("PSNDEV")="",ZTDESC="Report of Primary Drugs to be auto-created",ZTIO=""
 I  D ^%ZTLOAD K MJT,PSNDEV,%ZIS,POP,IOP,ZTSK D ^%ZISC Q
ENQ ;ENTRY POINT WHEN QUEUED
 D LOOP
 I $D(ZTQUEUED) D QUEUE1 G DONE
 U IO
ENQ1 S PSNPGCT=0,PSNPGLNG=IOSL-6
 D TITLE,LOOP1 W @IOF G DONE
TITLE I $D(IOF),IOF]"" W @IOF S PSNPGCT=PSNPGCT+1
 W !,?10,"REPORT OF ITEMS FROM LOCAL FILE IN WHICH PRIMARY DRUGS WILL BE CREATED",!!
 W !,"PRIMARY DRUG NAME" S X="T" D ^%DT X ^DD("DD") W ?55,"Date printed: ",Y,!,?8,"LOCAL DRUG NAME",?55,"Page: ",PSNPGCT,!
 F MJT=1:1:80 W "-"
 Q
DONE S:$D(ZTQUEUED) ZTREQ="@" K PSNB,PSNFLG,^TMP($J,"PSNPD"),PSNAME,PSNDA,PSNGN,PSNPGCT,PSNPGLNG,ZTRTN,Y,PSNDEV,MJT,PSNLOC,PSNAPP,PSNPD,SS,TT,IOP,POP,IO("Q"),X D ^%ZISC
 Q
QUEUE1 K ZTSAVE,ZTIO N ZTSK S ZTIO=PSNDEV,ZTRTN="ENQ1^PSJPRE46",ZTDESC="Report of Primary Drugs to be created",ZTDTH=$H,ZTSAVE("^TMP($J,""PSNPD"",")=""
 D ^%ZTLOAD K ^TMP($J,"PSNPD") Q
LOOP K ^TMP($J) F PSNB=0:0 S PSNB=$O(^PSDRUG(PSNB)) Q:'PSNB  S PSNAME=$P(^PSDRUG(PSNB,0),"^",1) I $D(^PSDRUG(PSNB,2)) S PSNAPP=$P(^PSDRUG(PSNB,2),"^",3) D GETAPPL
 Q
GETAPPL I PSNAPP["U"!(PSNAPP["I") D GETNODE
 Q
GETNODE I $D(^PSDRUG(PSNB,"ND")),$P(^PSDRUG(PSNB,"ND"),"^",2)]"" S PSNDA=$P(^PSDRUG(PSNB,"ND"),"^",1) I $D(^PSNDF(PSNDA)) S PSNGN=$P(^PSNDF(PSNDA,0),"^",1) I $L(PSNGN)<41 D BUILD
 Q
BUILD S ^TMP($J,"PSNPD",PSNGN,PSNAME)=""
 Q
LOOP1 S PSNPD="" F  S PSNPD=$O(^TMP($J,"PSNPD",PSNPD)) Q:PSNPD=""  S PSNFLG=1 D LOOP2
 Q
LOOP2 S PSNLOC="" F  S PSNLOC=$O(^TMP($J,"PSNPD",PSNPD,PSNLOC)) Q:PSNLOC=""  D WRITE
 Q
WRITE D:$Y>PSNPGLNG TITLE W:PSNFLG !!,PSNPD S PSNFLG=0 W !,?8,PSNLOC
 Q

PSJPRE47
PSJPRE47 ; B'ham ISC/WRT,CML3 -  creates Primary Drugs using the National Drug file ;3/23/92  18:31 [ 01/03/2002  10:42 AM ]
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 ;;3.2;;**28** Original VA Patch 28
 ;
 ;
MESSGE ;
 W @IOF,!?28,"PRIMARY DRUG AUTO-CREATE" W !!?2,"This option automatically creates PRIMARY DRUGS and ties them to drugs in",!,"your LOCAL DRUG FILE.  PRIMARY DRUGS are to be used by non-pharmacy personnel",!,"when ordering medications for"
 W " patients.  Primary Drugs DO NOT have a strength",!,"or dose form as part of their name."
 W !!?2,"PLEASE NOTE that this option creates PRIMARY DRUGS using the VA Generic Name",!,"of the National Drug File.  If the VA Generic Name is longer than forty (40)",!,"characters, it is not used and the Primary Drug is not created.  You"
 W " must run",!,"the 'Create Primary Drug (Manual)' option for the Primary Drugs not created by",!,"this option."
 I '$D(^PSNDF) W *7,!!,"This option cannot be run because there is no National Drug File online.",! S %=0 G DONE
 F  S %=2 W !!?2,"ARE YOU SURE YOU WANT TO CONTINUE" D YN^DICN Q:%  W !!?2,"Answer 'YES' to have this option start creating Primary Drugs.  Answer 'NO' to",!,"quit now."
 S PSJPRE4=1 D:%=1 LOOP
 ;
DONE ;
 K PSJI,PSJBEG,PSJEND,PSJMC,PSJPC,PSJPRE4,PSNDA,PSNB,PSNGN,PSNAPPL,PSNAP,PSNACT,PSNNFM,PSNIFN,PSNSH,PSNAPND,PSNAME,PSNPM,PSNX,PSNZ,PSNY,PSNDE,PSNAN D ENKV^PSGSETU Q
 Q
 ;
LOOP ;
 W !!,"Starting PRIMARY DRUG auto-create process..." S (PSJI,PSJPC,PSJMC,PSNB)=0,PSJBEG=$H
 F  S PSNB=$O(^PSDRUG(PSNB)) Q:'PSNB  S X=$G(^PSDRUG(PSNB,2)) I $P(X,U,3)["U"!($P(X,U,3)["I") S PSJI=PSJI+1 I '$P(X,U,6) S PSNAPPL=$P(X,U,3),X=$G(^("ND")) I X,$P(X,U,2)]"" S PSNGN=$P($G(^PSNDF(+X,0)),U) I PSNGN]"",$L(PSNGN)<41 D SETUP
 ;
END ;
 W !!,"The PRIMARY DRUG auto-create process has finished.",!!,"If possible, please record the following information:"
 S PSJEND=$H,PST=+PSJEND-(+PSJBEG)*86400+$P(PSJEND,",",2)-$P(PSJBEG,",",2),PST=PST\3600_":"_(PST#3600\60)_":"_(PST#60) F Q="PSJBEG","PSJEND" S %H=@Q D YX^%DTC S @Q=Y
 W !!,"Date/time auto-create started",?40,":",PSJBEG,!,"Date/time auto-create finished",?40,":",PSJEND,!,"Unit Dose/IV dispense drugs found",?40,":",PSJI,!,"Primary drugs created",?40,":",PSJPC,!,"Dispense drugs tied to a primary drug"
 W ?40,":",PSJMC,!,"Time auto-create took to run",?40,":",$P(PST,":")," hours, ",$P(PST,":",2)," minutes, ",$P(PST,":",3)," seconds.",!!
 Q
 ;
SETUP ;
 S X=$G(^PSDRUG(PSNB,0)),PSNSH=+$P(X,"^",3),PSNNFM=$P(X,"^",9),PSNACT=$S($G(^("I")):DT,1:"")
 S PSNIFN=$O(^PS(50.3,"B",PSNGN,0)) I PSNIFN,PSNSH,$P($G(^PS(50.3,PSNIFN,0)),"^",2)'=PSNSH S $P(^(0),"^",2)=""
 I 'PSNIFN K DA,DIC S DIC="^PS(50.3,",DIC(0)="LM",DLAYGO=50.3,X=PSNGN D ^DIC K DIC Q:Y'>0  S PSNIFN=+Y,PSJPC=PSJPC+1 S:PSNSH $P(^PS(50.3,PSNIFN,0),"^",2)=PSNSH
 K DA,DIE,DR S DIE="^PSDRUG(",DA=PSNB,DR="64////"_PSNIFN D ^DIE S PSJMC=PSJMC+1 W:'(PSJMC#100) "."
 F PSNAP="I","U" I PSNAPPL[PSNAP D BEGIN
 Q
 ;
BEGIN ;
 S PSNZ=$O(^PS(50.3,PSNIFN,1,"B",PSNAP,0)) G:'PSNZ CREATE
 S X=0,PSNY=$G(^PS(50.3,PSNIFN,1,PSNZ,0)) I PSNNFM="",$P(PSNY,"^",2) S $P(PSNY,"^",2)="",X=1
 I PSNACT,'$P(PSNY,"^",3) S $P(PSNY,"^",3)=PSNACT,X=1
 I X S ^PS(50.3,PSNIFN,1,PSNZ,0)=PSNY,$P(^PS(50.3,PSNIFN,1,"AFI",PSNAP),"^",1,2)='$P(PSNY,"^",2)_"^"_$P(PSNY,"^",3)
 Q
 ;
CREATE ;
 I '$D(^PS(50.3,PSNIFN,1,0)) S $P(^PS(50.3,PSNIFN,1,0),"^",2)=$P(^DD(50.3,1,0),"^",2)
 K DIC,DA S DIC="^PS(50.3,"_PSNIFN_",1,",DIC(0)="LMZ",DA(1)=PSNIFN,DLAYGO=50.31,X=PSNAP D ^DIC Q:Y'>0  S PSNZ=+Y,PSNY=Y(0)
 I PSNNFM!PSNACT S $P(PSNY,"^",2,3)=PSNNFM_"^"_PSNACT,^PS(50.3,PSNIFN,1,PSNZ,0)=PSNY,$P(^PS(50.3,PSNIFN,1,"AFI",PSNAP),"^",1,2)='$P(PSNY,"^",2)_"^"_$P(PSNY,"^",3)
 Q

PSJPRE48
PSJPRE48 ; B'ham ISC/MLM - IV ADDITIVE & SOLUTION REPORTS FOR PRE-RELEASE PACKAGE ;11/25/91  14:55 [ 01/03/2002  10:43 AM ]
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 ;;3.2;;**28** Original VA Patch 28
 ;
ENAD ; Entry point for Additives identified as MVI or Electrolytes
 S PTYP=1 G SETUP
 ;
ENSOL ; Entry point for Solutions used in IV Fluid OE.
 S PTYP=2 G SETUP
 ;
ENPD ; Entry point for PDs matched to IV drugs.
 S PTYP=3 G SETUP
 ;
SETUP ;
 D TITLE W @IOF,!?(80-$L(TITLE)\2),TITLE S X=LN D HELP1 W !!
 K DIR S DIR("A")="Include "_$S(PTYP=1:"Additives not identified as MVIs or Electrolytes",PTYP=2:"Solutions not marked as OE/RR IV Fluids?",1:"Additives and Solutions not matched to a Primary Drug")
 S DIR("??")="^D HELP^PSJPRE48",ZTDESC=TITLE_" REPORT",ZTRTN="DEQ^PSJPRE48"
 ;
ENQ ; Ask device and queue report.
 S DIR(0)="Y",DIR("B")="Y" D ^DIR K DIR G:$D(DIRUT) K S PSIVEX=Y
 W ! K IO("Q"),%ZIS,IOP S %ZIS="QM" D ^%ZIS I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED" G K
 G:'$D(IO("Q")) DEQ K ZTDTH,ZTSAVE,ZTSK S ZTIO=ION F X="PSIVEX","PTYP" S ZTSAVE(X)=""
 K IO("Q") D ^%ZTLOAD W:$D(ZTSK) !,"Queued." G K
 ;
DEQ ; Queued entry point.
 K ^TMP("PSIV",$J) D NOW^%DTC S Y=$E(%,1,7) X ^DD("DD") S PDATE="DATE PRINTED: "_Y,PGCNT=0,X=$S(PTYP=3:132,1:80),UL="",$P(UL,"-",X)=""
 D TITLE S X="DEQ"_$S(PTYP=3:3,1:1) D @X I 'PSIVEX,'$D(^TMP("PSIV",$J)) D NOMATCH,K Q
 S (FIL,PSIVQ)="" F  S FIL=$O(^TMP("PSIV",$J,FIL)) Q:PSIVQ!(FIL="")  D HD1 S P1="" F  S P1=$O(^TMP("PSIV",$J,FIL,P1)) Q:PSIVQ!(P1="")  S P2="" F  S P2=$O(^TMP("PSIV",$J,FIL,P1,P2)) Q:PSIVQ!(P2="")  D PRINT
 W:$E(IOST)'="C" @IOF D ^%ZISC
 ;
K ;
 K D,DRG,DRGN,DRGPTR,DTOUT,DUOUT,FIL,GDRG,HT,HT1,LN,ND,P1,P2,P3,PDATE,PDRG,PDRGN,PGCNT,POP,PSIVEX,PSIVQ,PTYP,TITLE,UL,ZTDESC,ZTRTN,^TMP("PSIV",$J) D ENIVKV^PSGSETU
 Q
 ;
DEQ1 ; Entry for Additive/Solution report.
 S FIL=$S(PTYP=1:52.6,1:52.7) F DRG=0:0 S DRG=$O(^PS(FIL,DRG)) Q:'DRG  S ND=$G(^PS(FIL,DRG,0)),P1=$P(ND,U),P2=$P(ND,U,11) D:PSIVEX!+P2 SET
 Q
 ;
DEQ3 ; Entry for primary/IV drug report.
 F FIL=52.6,52.7 F DRG=0:0 S DRG=$O(^PS(FIL,DRG)) Q:'DRG  S ND=$G(^PS(FIL,DRG,0)),P1=$P(ND,U)_$S(FIL=52.7:" "_$P(ND,U,3),1:""),GDRG=$P(ND,U,2),PDRG=$P(ND,U,12) D:PSIVEX!PDRG SET
 Q
 ;
PRINT ;
 W:P1'="ZZZZZ" P1 W " " W:PTYP=1 ?68 W:PTYP=3 ?40 W:P2'="ZZZZZ" P2 I PTYP=1 W ! D:$Y+5>IOSL HD
 I PTYP>1 F DRGPTR=0:0 S DRGPTR=$O(^TMP("PSIV",$J,FIL,P1,P2,DRGPTR)) Q:'DRGPTR  S P3=^TMP("PSIV",$J,FIL,P1,P2,DRGPTR),X="?"_$S(PTYP=2:60,1:90) W @X W:P3'="ZZZZZ" P3 W ! D:$Y+5>IOSL HD
 Q
 ;
SET ;
 I PTYP=1 S P2=$S(P2=1:"ELECTROLYTE",P2=2:"MULTIVITAMIN",1:"ZZZZZ"),^TMP("PSIV",$J,+FIL,P1,P2)="" Q
 S:PTYP=2 P3=$S($P(ND,U,3):$P(ND,U,3),1:""),P2=$S(P2=1:"YES",1:"")
 S:PTYP=3 P3=$P($G(^PSDRUG(+GDRG,0)),U),P2=$P($G(^PS(50.3,+PDRG,0)),U) F X=1:1:3 S:@("P"_X)="" @("P"_X)="ZZZZZ"
 S ^TMP("PSIV",$J,+FIL,P1,P3,+DRG)=P2
 Q
 ;
NOMATCH ; Print msg. if none.
 S PSIVQ=1,FIL=52.6 D HD1 W !!!! I PTYP=3 W ?36,"No Additives or Solutions have been matched to Primary Drugs.",!! Q
 S X="No "_$S(PTYP=1:"Additives",1:"Solutions")_" have been marked "_$S(PTYP=1:"as MVIs or Electrolytes",1:"for use in IV Fluid Order Entry")_"." W ?(80-$L(X))/2,X,!! Q
 Q
 ;
HD ;
 I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR K DIR I $D(DUOUT)!($D(DTOUT)) S PSIVQ=1 Q
HD1 ; Report Header.
 S PGCNT=PGCNT+1,X=$S(PTYP=3:132,1:80) W @IOF,!?(X-$L(TITLE))/2,TITLE,!,?(X-$L(PDATE))/2,PDATE W:PTYP=3 ?110 W:PTYP<3 ?68 W "Page No. ",$J(PGCNT,3),!!
 I PTYP=1 W "ADDITIVE",?68,"TYPE"
 E  I PTYP=2 W ?60,"OE/RR",!,"SOLUTION",?60,"IV FLUID"
 E  I PTYP=3 W $S(FIL=52.6:"ADDITIVE",1:"SOLUTION"),?40,"GENERIC DRUG",?90,"PRIMARY DRUG"
 W !,UL,!!
 Q
 ;
TITLE ;
 S TITLE=$S(PTYP=1:"ADDITIVES IDENTIFIED AS ELECTROLYTES OR MULTIVITAMINS",PTYP=2:"SOLUTIONS MARKED FOR USE IN IV FLUID ORDER ENTRY THROUGH OE/RR",1:"PRIMARY DRUGS MATCHED TO IV ADDITIVES AND SOLUTIONS")
 S LN="This report will show "
 I PTYP=1 S LN=LN_"additives that have been identified as electrolytes     or multivitamins. You may list all additives, or only those identified as electrolytes or multivitamins." Q
 I PTYP=2 S LN=LN_"solutions that have been marked for use in IV Fluid order entry through OE/RR. You may list all additives, or only those marked    for use in IV Fluid order entry." Q
 I PTYP=3 S LN=LN_"the primary drug and generic drug matched to each additive and solution. You may list all"
 I  S LN=LN_" additives and solutions, or only    those additives and solutions matched to a primary drug. This report    requires 132 columns for output."
 Q
 ;
HELP ;
 S HT=$S(PTYP=1:"additives",PTYP=2:"solutions",1:"additives and solutions"),HT1=$S(PTYP=1:"rked as MVIs or Electrolytes",PTYP=2:"rked for use in IV Fluid order entry through OE/RR",1:"tched to a primary drug")_"."
 F X="Enter ""NO"" to list only those "_HT_" that have been ma"_HT1,"Enter ""YES"" to list all "_HT_" even if they have not been ma"_HT1 D HELP1
 Q
 ;
HELP1 ;
 W !!,?2 F LN=1:1:$L(X," ") S Y=$P(X," ",LN) W:$X+$L(Y)>78 ! W Y," " W:$E(Y,$L(Y))="." " "
 Q

PSJPRE49
PSJPRE49 ; B'ham ISC/MLM - Edit Pharmacy fields in 200/Print Active Providers from File 6 ; 3/17/92 [ 01/03/2002  10:43 AM ]
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 ;;3.2;;**28** Original VA Patch 28
 ;
ENE ; Entry point for editing Pharmacy fields in 200.
 D PROED^PSJPRE4H F  N DA,DIC,DIE S DIC="^VA(200,",DIC(0)="AEQM" D ^DIC Q:Y<0  S DA=+Y,DIE=DIC,DR="53.1;53.4" D ^DIE
 Q
 ;
ENP ; Entry point for printing Provider list from file 6.
 D PROPR^PSJPRE4H
 ;
ENQ ; Ask device and queue report.
 W ! K IO("Q"),%ZIS,IOP S %ZIS="QM" D ^%ZIS I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED" G K
 G:'$D(IO("Q")) DEQ K ZTDTH,ZTSAVE,ZTSK S ZTIO=ION,ZTDESC="ACTIVE PROVIDERS REPORT",ZTRTN="DEQ^PSJPRE49" K IO("Q") D ^%ZTLOAD W:$D(ZTSK) !,"Queued."
 Q
 ;
DEQ ; Queued entry point.
 K ^TMP("PSIV",$J) D NOW^%DTC S (TDTE,Y)=$E(%,1,7) X ^DD("DD") S PDATE=Y,PGCNT=0,UL="",$P(UL,"-",80)=""
 F P6=0:0 S P6=$O(^DIC(6,P6)) Q:'P6  S PDTE6=$P($G(^DIC(6,+P6,"I")),U) I $S('PDTE6:1,PDTE6>TDTE:1,1:0) S P200=+$G(^DIC(16,P6,"A3")),PNME=$P($G(^VA(200,P200,0)),U) D:PNME]""
 .S ND=$G(^VA(200,P200,"PS")),PAUTH=$P(ND,U),PDTE200=$P(ND,U,4)
 .F I="PDTE6","PDTE200" S Y=@I X ^DD("DD") S @I=$P(Y,"@")_" "_$P(Y,"@",2)
 .S ^TMP("PSIV",$J,$P(PNME,U)_U_P200)=PDTE6_U_PDTE200_U_PAUTH
 ;
PRINT ; Print report.
 D HD1 I '$D(^TMP("PSIV",$J)) W !,"No active Providers found in the PROVIDER File (6)." G K
 S (PNME,PSIVQ)="" F  S PNME=$O(^TMP("PSIV",$J,PNME)) Q:PNME=""!(PSIVQ)  S ND=$G(^TMP("PSIV",$J,PNME)) W $P(PNME,U),?35,$P(ND,U),?53,$P(ND,U,2),?73,$S($P(ND,U,3):"YES",1:""),! D:$Y+5>IOSL HD
 W:$E(IOST)'="C" @IOF D ^%ZISC
K ; Kill, close device, exit.
 K ^TMP("PSIV",$J),%,%ZIS,DIRUT,DTOUT,DUOUT,I,ND,P200,P6,PAUTH,PDATE,PDTE200,PDTE6,PGCNT,PNME,PSIVQ,TDTE,UL,Y
 Q
HD ;
 I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR K DIR I $D(DUOUT)!($D(DTOUT)) S PSIVQ=1 Q
HD1 ; Report Header.
 S PGCNT=PGCNT+1 W @IOF,!,?28,"ACTIVE PROVIDER REPORT",!,?27,"Date Printed: ",PDATE,?68,"Page No. ",PGCNT,!!!
 W ?53,"PHARMACY NEW",!,?35,"PROVIDER FILE",?53,"PERSON FILE",?70,"AUTH. TO",!,?35,"INACTIVATION",?53,"INACTIVATION",?70,"WRITE MED.",!,"PROVIDER NAME",?35,"DATE",?53,"DATE",?70,"ORDERS",!,UL,!!
 Q

PSJPRE4H
PSJPRE4H ; B'ham ISC/CML3 - HELP TEXT ;4/23/92  00:03 [ 01/03/2002  10:44 AM ]
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 ;;3.2;;**28** Original VA Patch 28
 ;
PSH ;
 W !!?2,"If you answer 'YES', you will prompted for the primary for these drugs.  If",!,"you answer 'NO', you will be prompted to select which of these drug can be"
 W !,"given the same primary drug.  If you enter an '^', you will exit this option." Q
 ;
PSELH ;
 W !!?2,"Select drugs from the above list that you want to tie to the same primary",!,"drug.  Select the drugs by number.  Enter an '^' to see the list of drugs",!,"again." Q
 ;
PROED ; Display description for Provider Edit.
 D PRODESC W "  This option allows editing of the AUTHORIZED TO WRITE MED ORDERS and the",!
 W "Pharmacy INACTIVE DATE fields of the NEW PERSON file, so that the appropriate",!,"entries may be used by Inpatient Medications version 4.0.",!!
 Q
 ;
PROPR ; Display description for Provder Report.
 D PRODESC W " This report lists active entries in the PROVIDER file (6), and may be used",!
 W "to determine the entries in the NEW PERSON file that should be marked as",!,"AUTHORIZED TO WRITE MED ORDERS before version 4.0 of Inpatient Medications",!,"is installed.",!!
 Q
 ;
PRODESC ; This is displayed for both the provider edit and report.
 W @IOF,!," In previous versions of the Inpatient Medications package (Unit Dose and IV),",!,"providers used in order entry were selected from the PROVIDER file (6). After",!
 W "installation of version 4.0 of Inpatient Medications, only active entries",!,"marked as ""AUTHORIZED TO WRITE MED ORDERS"" in the NEW PERSON file (200) will",!,"be allowed in IV or Unit Dose order entry.",!!
 Q
ENSYNMSG ; opening text for synonym move option
 W @IOF,!!?13,"MOVE TRADE NAMES FROM DRUG FILE TO PRIMARY DRUG FILE"
 W !!?2,"This process will search through your DRUG file for items that have a Primary",!,"Drug assigned and one or more synonyms that have been marked as trade names."
 W !,"For each item found that meets this criteria, the synonyms that have been",!,"marked as trade names will be copied to the corresponding Primary Drug."
 W !!?2,"PLEASE NOTE that only synonyms marked as a TRADE NAME are copied.",!!?2,"This process will tie up your terminal while running and may take an hour or",!,"more to run.",!
 Q
 ;
ENTOUMSG ; opening text for type of user report
 W @IOF,!!?24,"INPATIENT NEW PERSON USER REPORT"
 W !!?2,"This report will show how Inpatient Medications version 4 will designate the",!,"site's users (pharmacist, nurse, pharmacy technician, provider, etc.).  With",!,"version 4, Inpatient Medications will no longer use the User, Person, or"
 W !,"Provider files, but will instead use the New Person File and the new security",!,"keys to determine user designations.",!!,"  Please see the ""Pre-Release Patch"" Appendix in the User Manual for more",!,"details.",!
 Q

PSJPRE4I
PSJPRE4I ; B'ham ISC/CML3 - PRE-INIT ;9/4/91  21:53 [ 01/03/2002  10:44 AM ]
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 ;;3.2;;**28** Original VA Patch 28
 ;
 I $G(^PS(59.7,1,20))<3.2 W *7,!!,"Inpatient Medications version 3.2 must be installed before you can install",!,"this patch." K DIFQ
 Q

PSJPRE4P
PSJPRE4P ; B'ham ISC/CML3 - POST INIT ;2/11/92  16:49 [ 01/03/2002  10:45 AM ]
 ;;3.2;INPATIENT MEDICATIONS;**3**;JAN 03, 2002
 ;;3.2;;**28** Original VA Patch 28
 ;
 D NOW^%DTC S Y=% X ^DD("DD") W !!,"POST INIT STARTED at ",Y,"..."
 W !,"...Updating the DRUG file for IV ADDITIVES and IV SOLUTIONS..."
 S PSIUX="I" F Q1=52.6,52.7 F Q2=0:0 S Q2=$O(^PS(Q1,Q2)) Q:'Q2  S PSIUDA=$P($G(^(Q2,0)),"^",2) I PSIUDA W "." D ENS^PSGIU
 W ! D ENAK
 W !!,"...I must delete and rebuild the 'B' cross-reference of your Drug File (50)..."
 K ^PSDRUG("B") S X=0 F Z=1:1 S X=$O(^PSDRUG(X)) Q:'X  S Y=$P($G(^(X,0)),"^") I Y]"" S ^PSDRUG("B",$E(Y,1,40),X)="" W:'(Z#100) "." R Q:0 I  W !,"...currently on entry number ",X,"  (",Y,")..."
 K PSIUX,PSIUDA,Q1,Q2 D NOW^%DTC S Y=%,$P(^PS(59.7,1,20),"^",13)=% X ^DD("DD") W !,"...POST INIT COMPLETED at ",Y,"." Q
 ;
ENAK ; assign keys
 K DIC S DIC="^DIC(19.1,",DIC(0)="LM",DLAYGO=19.1 F KEY="1^PSJ RPHARM","2^PSJ RNURSE","3^PSJ PHARM TECH" S X=$P(KEY,"^",2) W !,"...creating the ",X," key..." D ^DIC W "." D:Y'>0 FILE^DICN S @("KEY"_+KEY)=+Y
 W !!,"...creating key holders..."
 K PSJSF S KEYF=$D(^DD(19.12))>0+1,(HOLDER,PSJC,PSJSF,Q)=0 F  S Q=$O(^PS(59.4,Q)) Q:'Q  S PSJSF=PSJSF+1,PSJSF(PSJSF)=Q
 F  S HOLDER=$O(^XUSEC("PSJU RPH",HOLDER)) Q:'HOLDER  S KEY=KEY2 D  S PSJC=PSJC+1 W:'(PSJC#200) "."
 .F Q=1:1:PSJSF I $D(^PS(59.4,PSJSF(Q),1,"B",HOLDER)) S KEY=KEY1 Q
 .I '$D(^XUSEC($P("PSJ RPHARM^PSJ RNURSE","^",KEY=KEY2+1),HOLDER)) D @KEYF
 S KEY=KEY3 F  S HOLDER=$O(^XUSEC("PSJU PL",HOLDER)) Q:'HOLDER  I '$D(^XUSEC("PSJ RPHARM",HOLDER)),'$D(^XUSEC("PSJ PHARM TECH",HOLDER)) D @KEYF S PSJC=PSJC+1 W:'(PSJC#200) "."
 ;
KDONE ;
 K DA,DIC,DLAYGO,HOLDER,KEY,KEY1,KEY2,KEY3,KEYF,PSJC,PSJSF,Q,X,Y Q
 ;
1 ; laygo into key sub-file of 200
 K DA,DIC S:'$D(^VA(200,HOLDER,51,0)) ^VA(200,HOLDER,51,0)="^"_$P(^DD(200,51,0),"^",2)
 S DA(1)=HOLDER,DIC="^VA(200,"_HOLDER_",51,",DIC(0)="LM",DLAYGO=200.051,(DINUM,X)=KEY D FILE^DICN Q
 ;
2 ; laygo into holder sub-file of 19.1
 K DA,DIC S:'$D(^DIC(19.1,KEY,2,0)) ^DIC(19.1,KEY,2,0)="^"_$P(^DD(19.1,2,0),"^",2)
 S DA(1)=KEY,DIC="^DIC(19.1,"_KEY_",2,",DIC(0)="LM",DLAYGO=19.12,X=HOLDER D FILE^DICN Q



