Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSJIPST3

PSJIPST3.m

Go to the documentation of this file.
  1. PSJIPST3 ;BIR/MLM-CONVERT PSJ 4.5 QUICK ORDERS FOR USE IN OE/RR 3.0 ; 15 May 98 / 10:56 AM
  1. ;;5.0; INPATIENT MEDICATIONS ;**3,5**;16 DEC 97
  1. ;
  1. EN(PROTIEN) ;
  1. ; THIS CALL NOT USED ANYMORE... IT IS IN ^PSSQOC
  1. Q
  1. ;
  1. GTPC ; Set up TMP for provider comments
  1. I $O(^PS(57.1,+PSJQOPTR,2,0)) D
  1. .S CNT=0 F X=0:0 S X=$O(^PS(57.1,+PSJQOPTR,2,X)) Q:'X D
  1. ..S Y=$G(^PS(57.1,PSJQOPTR,2,X,0)) S:Y]"" CNT=CNT+1,^TMP("PSJQO",$J,"PC",CNT,0)=Y
  1. .S:$O(^TMP("PSJQO",$J,"PC",0)) ^TMP("PSJQO",$J,"PC",0)=CNT_U_CNT
  1. Q
  1. 111 ; Order Set Conversion
  1. CONVOS ;Convert Order Sets in ^PS(53.2,
  1. D MES^XPDUTL(" ") D MES^XPDUTL("Converting Unit Dose Order Sets......")
  1. N PSJNUM,PSJNUM2,PSJND,S,PSJCC,FLAG,PSJOCNT,PSJ50P7
  1. S S="PSJOS" K ^TMP(S,$J)
  1. F PSJNUM=0:0 S PSJNUM=$O(^PS(53.2,PSJNUM)) Q:'PSJNUM D
  1. .Q:'$O(^PS(53.2,PSJNUM,1,0))
  1. .S ^TMP(S,$J,PSJNUM,0)=$P(^PS(53.2,PSJNUM,0),"^")
  1. .F PSJNUM2=0:0 S PSJNUM2=$O(^PS(53.2,PSJNUM,1,PSJNUM2)) Q:'PSJNUM2 D
  1. ..S ^TMP(S,$J,PSJNUM,1,PSJNUM2,0)=^PS(53.2,PSJNUM,1,PSJNUM2,0)
  1. ..S ^TMP(S,$J,PSJNUM,1,PSJNUM2,1)=$G(^PS(53.2,PSJNUM,1,PSJNUM2,1))
  1. ..F PSJND=0:0 S PSJND=$O(^PS(53.2,PSJNUM,1,PSJNUM2,2,PSJND)) Q:'PSJND D
  1. ...S ^TMP(S,$J,PSJNUM,1,PSJNUM2,2,PSJND,0)=^PS(53.2,PSJNUM,1,PSJNUM2,2,PSJND,0)
  1. ..I '$$CHECK(PSJNUM,PSJNUM2,S) S ^TMP(S,$J,"BAD",PSJNUM)=1
  1. ..E S ^TMP(S,$J,PSJNUM,2,PSJNUM2,"50.7PT")=PSJ50P7
  1. D CONVERT D:$D(^TMP(S,$J)) MAILMESS(PSJOCNT) K ^TMP(S,$J)
  1. D NOW^%DTC S $P(^PS(59.7,1,20.5),U,4)=%
  1. D MES^XPDUTL(" .....finished") W !
  1. D SDCON ; queue up conversion of Order sets to OERR quick orders
  1. Q
  1. CONVERT ;
  1. N PSJNUM,PSJNUM2,PSJND,PSJT,M1,L1,M2,L2
  1. F PSJNUM=0:0 S PSJNUM=$O(^TMP(S,$J,PSJNUM)) Q:'PSJNUM D
  1. .Q:$D(^TMP(S,$J,"BAD",PSJNUM)) ; doesn't convert the bad ones
  1. .S PSJOCNT=$S('$D(PSJOCNT):1,1:PSJOCNT+1)
  1. .S M1=^PS(53.2,PSJNUM,1,0),L1=$L(M1),M1=$E(M1,(L1-3),L1)
  1. .S ^PS(53.2,PSJNUM,2,0)="^53.22PA"_M1
  1. .F PSJNUM2=0:0 S PSJNUM2=$O(^TMP(S,$J,PSJNUM,1,PSJNUM2)) Q:'PSJNUM2 D
  1. ..S ^PS(53.2,PSJNUM,2,PSJNUM2,0)=^TMP(S,$J,PSJNUM,1,PSJNUM2,0)
  1. ..S $P(^PS(53.2,PSJNUM,2,PSJNUM2,0),"^")=^TMP(S,$J,PSJNUM,2,PSJNUM2,"50.7PT")
  1. ..S PSJT=$S($L(^TMP(S,$J,PSJNUM,1,PSJNUM2,1)):1,1:0)
  1. ..I PSJT S ^PS(53.2,PSJNUM,2,PSJNUM2,1)=$G(^TMP(S,$J,PSJNUM,1,PSJNUM2,1))
  1. ..F PSJND=0:0 S PSJND=$O(^TMP(S,$J,PSJNUM,1,PSJNUM2,2,PSJND)) Q:'PSJND D
  1. ...S ^PS(53.2,PSJNUM,2,PSJNUM2,2,PSJND,0)=^TMP(S,$J,PSJNUM,1,PSJNUM2,2,PSJND,0)
  1. ..I $D(^PS(53.2,PSJNUM,1,PSJNUM2,2,0)) D ;if no disp. drug don't set
  1. ...S M2=^PS(53.2,PSJNUM,1,PSJNUM2,2,0),L2=$L(M2),M2=$E(M2,(L2-3),L2)
  1. ...S ^PS(53.2,PSJNUM,2,PSJNUM2,2,0)="^53.23P"_M2
  1. S DIK="^PS(53.2," D IXALL^DIK
  1. Q
  1. CHECK(PSJNUM,PSJNUM2,S) ; check to see if different Orderable Items
  1. N PSJFIRST,PSJCC,PSDRUG S FLAG=1
  1. F PSJCC=0:0 S PSJCC=$O(^TMP(S,$J,PSJNUM,1,PSJNUM2,2,PSJCC)) Q:'PSJCC D
  1. .Q:'FLAG
  1. .S PSDRUG=$P(^TMP(S,$J,PSJNUM,1,PSJNUM2,2,PSJCC,0),"^")
  1. .S PSJ50P7=+$P($G(^PSDRUG(PSDRUG,2)),"^")
  1. .I '$D(PSJFIRST) S PSJFIRST=PSJ50P7,FLAG=1
  1. .E S FLAG=(PSJFIRST=PSJ50P7)
  1. .S:PSJ50P7=0 FLAG=0 ; sets flag to quit if drug has no Ord Item
  1. Q FLAG
  1. MAILMESS(C) ; send mail msg for Order Set conversion
  1. K XMY N LOOP,CNT S XMSUB="Inpatient Medications ORDER SETS conversion"
  1. S XMDUZ="INPATIENT MEDICATIONS Version 5.0 Install",XMTEXT="PSJTEXT1("
  1. F LOOP=0:0 S LOOP=$O(^XUSEC("PSJU MGR",LOOP)) Q:'LOOP D
  1. .S XMY(LOOP)=""
  1. S XMY(DUZ)=""
  1. S PSJTEXT1(1,0)="The conversion of the Unit Dose Order sets has completed."
  1. S PSJTEXT1(2,0)="A total of "_C_" order sets were converted."
  1. I $D(^TMP(S,$J,"BAD")) D
  1. .S (PSJTEXT1(3,0),PSJTEXT1(8,0))=""
  1. .S PSJTEXT1(5,0)="The following Order Sets contained drugs that have"
  1. .S PSJTEXT1(5,0)=PSJTEXT1(5,0)_" more than one Dispense drug,"
  1. .S PSJTEXT1(6,0)="or dispense drugs that are inactive."
  1. .S PSJTEXT1(7,0)="These Dispense drugs are not linked to the same Ordera"
  1. .S PSJTEXT1(7,0)=PSJTEXT1(7,0)_"ble item."
  1. .S PSJTEXT1(8,0)="Please REENTER these Order Sets through the menu option."
  1. .F LOOP=0:0 S LOOP=$O(^TMP(S,$J,"BAD",LOOP)) Q:'LOOP D
  1. ..S CNT=$S('$D(CNT):1,1:CNT+1)
  1. ..S PSJTEXT1(CNT+9,0)=" ** "_$P($G(^PS(53.2,LOOP,0)),"^")_" needs to be reentered"
  1. N DIFROM D ^XMD K XMSUB,XMDUZ,XMTEXT,PSJTEXT1
  1. Q
  1. BADNAMES ;
  1. D NOW^%DTC S $P(^PS(59.7,1,20.5),U,2)=%
  1. I '$O(^XTMP("PSJ NEW PERSON",0)) K ^XTMP("PSJ NEW PERSON") Q
  1. ; fill in ^XTMP zero node
  1. N PSJDATE1,PSJDATE2
  1. D NOW^%DTC S PSJDATE1=X,X1=X,X2=7 D C^%DTC S PSJDATE2=X
  1. S ^XTMP("PSJ NEW PERSON",0)=PSJDATE2_"^"_PSJDATE1_"^"_"List of changed User Names in IV orders"
  1. S ^XTMP("PSJ NEW1",0)=PSJDATE2_"^"_PSJDATE1_"^"_"List of changed User Names in IV orders"
  1. S Y=PSJDATE2 X ^DD("DD") S PSJDATE2=Y
  1. K XMY S XMSUB="Changed user names in IV file"
  1. S XMDUZ="INPATIENT MEDICATIONS Version 5.0 Install",XMTEXT="PSJTEXT1("
  1. F LOOP=0:0 S LOOP=$O(^XUSEC("PSJI MGR",LOOP)) Q:'LOOP D
  1. .S XMY(LOOP)=""
  1. S PSJTEXT1(1,0)="The following names were found in IV orders and don't have exact matches in"
  1. S PSJTEXT1(2,0)="the NEW PERSON FILE."
  1. S PSJTEXT1(3,0)=""
  1. N CNT S LOOP=0 F S LOOP=$O(^XTMP("PSJ NEW PERSON",LOOP)) Q:LOOP="" D
  1. .S CNT=$S('$D(CNT):1,1:CNT+1)
  1. .S PSJTEXT1((CNT+4),0)=" "_LOOP
  1. S PSJTEXT1((CNT+5),0)=" "
  1. S PSJTEXT1((CNT+6),0)="This message is sent to all the Inpatient pharmacists."
  1. S PSJTEXT1((CNT+7),0)="This job should most likely be handled by the Pharmacy Service ADP coordinator."
  1. S PSJTEXT1((CNT+8),0)="It is VERY IMPORTANT that these names be corrected. Please have IRM assign"
  1. S PSJTEXT1((CNT+9),0)="someone the Inpatient Medications option, PSJI 200, ""Correct changed User"
  1. S PSJTEXT1((CNT+10),0)="Names in IV orders"". Then run this option to correct the names."
  1. S PSJTEXT1((CNT+11),0)="This correction should be done as soon as possible, or at the latest "
  1. S PSJTEXT1((CNT+12),0)="by "_PSJDATE2_"."
  1. N DIFROM D ^XMD K XMSUB,XMDUZ,XMTEXT,PSJTEXT1
  1. ; PSJ*5*5 cleanup jobs
  1. D BADN^PSJ005
  1. Q
  1. ;
  1. SDCON ; begin convertion of S. Order Sets to OERR quick orders
  1. S ZTDTH=$H,ZTIO="",ZTRTN="SDOT^PSJIPST3",ZTDESC="Conversion of Unit Dose Order sets to OERR Quick Orders" D ^%ZTLOAD
  1. I $D(ZTSK) D MES^XPDUTL(" Job to convert Unit Dose Order Sets to OERR Quick Orders is queued. TASK #"_$G(ZTSK))
  1. Q
  1. SDOT ;
  1. S PS="PSJQOS" F PSJ1=0:0 S PSJ1=$O(^PS(53.2,PSJ1)) Q:'PSJ1 D
  1. . Q:'$D(^PS(53.2,PSJ1,2)) K ^TMP(PS) S ^TMP(PS,$J,"NM")=^PS(53.2,PSJ1,0)
  1. . F PSJ2=0:0 S PSJ2=$O(^PS(53.2,PSJ1,2,PSJ2)) Q:'PSJ2 D
  1. .. S $P(^TMP(PS,$J,PSJ2,1),"^")=$P($G(^PS(53.2,PSJ1,2,PSJ2,0)),"^")
  1. .. S $P(^TMP(PS,$J,PSJ2,1),"^",2)=$P($G(^PS(53.2,PSJ1,2,PSJ2,0)),"^",3)
  1. .. S $P(^TMP(PS,$J,PSJ2,1),"^",3)=$P($G(^PS(53.2,PSJ1,2,PSJ2,0)),"^",5)
  1. .. S $P(^TMP(PS,$J,PSJ2,1),"^",4)=$P($G(^PS(53.2,PSJ1,2,PSJ2,0)),"^",9)
  1. .. S ^TMP(PS,$J,PSJ2,2)=$G(^PS(53.2,PSJ1,2,PSJ2,1)) K CNTT
  1. .. F PSJDS=0:0 S PSJDS=$O(^PS(53.2,PSJ1,2,PSJ2,2,PSJDS)) Q:'PSJDS D
  1. ... Q:$D(CNTT)
  1. ... S $P(^TMP(PS,$J,PSJ2,3),"^")=$P($G(^PS(53.2,PSJ1,2,PSJ2,2,PSJDS,0)),"^")
  1. ... S $P(^TMP(PS,$J,PSJ2,3),"^",2)=$P($G(^PS(53.2,PSJ1,2,PSJ2,2,PSJDS,0)),"^",2),CNTT=1
  1. . D PSJQOS^ORCONV3 ; call to OERR to process each Order Set
  1. K CNTT,^TMP(PS),PS,PSJ1,PSJ2,PSJDS Q