PSS160PO ;BIR/RTR-Post Install routine for patch PSS*1*160 ;02/18/11
;;1.0;PHARMACY DATA MANAGEMENT;**160**;9/30/97;Build 76
;External reference to ^XOB(18.02 supported by DBIA 5814
;External reference to ^XOB(18.12 supported by DBIA 5813
;
;
EN ;Do Mail Message
N PSSMXUA1,PSSMXUA2 S PSSMXUA2=0
F PSSMXUA1=0:0 S PSSMXUA1=$O(@XPDGREF@("PSSMLMSG",PSSMXUA1)) Q:'PSSMXUA1 S PSSMXUA2=PSSMXUA2+1
S PSSMXUA2=PSSMXUA2+1
D ADDVAL,MNUADD,SETWS
D BMES^XPDUTL("Generating Mail Message....")
EN2 ;
D MAIL D BMES^XPDUTL("Mail message sent.")
I $P($G(^PS(59.7,1,81)),"^")="" S $P(^PS(59.7,1,81),"^")=1
Q
;
;
MAIL ;Send mail message
N PSS60REC,PSS60PLP,XMTEXT,XMY,XMSUB,XMDUZ,XMMG,XMSTRIP,XMROU,XMYBLOB,XMZ,XMDUN
K ^TMP($J,"PSS60PTX")
F PSS60PLP=0:0 S PSS60PLP=$O(@XPDGREF@("PSSMLMSG",PSS60PLP)) Q:'PSS60PLP S ^TMP($J,"PSS60PTX",PSS60PLP)=@XPDGREF@("PSSMLMSG",PSS60PLP)
S XMSUB="PSS*1*160 Installation Complete"
S XMDUZ="PSS*1*160 Install"
S XMTEXT="^TMP($J,""PSS60PTX"","
S PSS60REC="" F S PSS60REC=$O(@XPDGREF@("PSSMLMDZ",PSS60REC)) Q:PSS60REC="" S XMY(PSS60REC)=""
N DIFROM D ^XMD
K ^TMP($J,"PSS60PTX")
Q
;
;
MNUADD ;Add PSS DRUG DOSING LOOKUP option to PSS DOSAGE MANAGEMENT menu option
D BMES^XPDUTL("Linking New PSS DRUG DOSING LOOKUP Option....")
N PSSMXUA,PSSMXUAF
S PSSMXUAF=0
K PSSMXUA S PSSMXUA=$$ADD^XPDMENU("PSS DOSAGES MANAGEMENT","PSS DRUG DOSING LOOKUP",,9) I 'PSSMXUA D
.S PSSMXUAF=1
.D BMES^XPDUTL("Unable to link PSS DRUG DOSING LOOKUP Option....") D BMES^XPDUTL("Please log a Remedy Ticket for this issue.")
.S @XPDGREF@("PSSMLMSG",PSSMXUA2)="Unable to link PSS DRUG DOSING LOOKUP Option to PSS DOSAGES MANAGEMENT Menu" S PSSMXUA2=PSSMXUA2+1
.S @XPDGREF@("PSSMLMSG",PSSMXUA2)=" ",PSSMXUA2=PSSMXUA2+1 S @XPDGREF@("PSSMLMSG",PSSMXUA2)="Please log a Remedy Ticket and refer to this message." S PSSMXUA2=PSSMXUA2+1 D LINE
I 'PSSMXUAF D BMES^XPDUTL("New PSS DRUG DOSING LOOKUP option linked successfully...")
;
D BMES^XPDUTL("Linking New PSS TRAILING SPACES REPORT Option....")
K PSSMXUA,PSSMXUAF
S PSSMXUAF=0
S PSSMXUA=$$ADD^XPDMENU("PSS DOSAGES MANAGEMENT","PSS TRAILING SPACES REPORT",,10) I 'PSSMXUA D
.S PSSMXUAF=1
.D BMES^XPDUTL("Unable to link PSS TRAILING SPACES REPORT Option....") D BMES^XPDUTL("Please log a Remedy Ticket for this issue.")
.S @XPDGREF@("PSSMLMSG",PSSMXUA2)="Unable to link PSS TRAILING SPACES REPORT Option to PSS DOSAGES MANAGEMENT Menu" S PSSMXUA2=PSSMXUA2+1
.S @XPDGREF@("PSSMLMSG",PSSMXUA2)=" ",PSSMXUA2=PSSMXUA2+1 S @XPDGREF@("PSSMLMSG",PSSMXUA2)="Please log a Remedy Ticket and refer to this message." S PSSMXUA2=PSSMXUA2+1 D LINE
I 'PSSMXUAF D BMES^XPDUTL("New PSS TRAILING SPACES REPORT option linked successfully...")
Q
;
;
ADDVAL ; Final validation of data
D BMES^XPDUTL("Validating new Dose Unit File (#51.24) entries.")
N PSSADUC1,PSSADUC2,PSSADUC5,PSSADUC6,PSSADUC7,PSSADUC8,PSSADUK1,PSSADUK2,PSSADUK3,PSSATYPE
S (PSSADUK1,PSSADUK2,PSSADUK3)=0,PSSATYPE="FILM(S)"
S PSSADUC1=$$FIND1^DIC(51.24,"","X",PSSATYPE,"B") I +PSSADUC1'=52 D ADDKTM S PSSADUK1=1 G ADDLUN
I $$ADDCHK() S PSSADUK1=1 G ADDLUN
I $G(^PS(51.24,52,0))'="FILM(S)^FILMS^1" S PSSADUK1=1 G ADDLUN
F PSSADUC5="FILM;1","FILMS;2" Q:PSSADUK1 D
.S PSSADUC6=$P(PSSADUC5,";"),PSSADUC7=$P(PSSADUC5,";",2)
.S PSSADUC8=$$FIND1^DIC(51.242,",52,","X",PSSADUC6,"B")
.I $$ADDCHK() S PSSADUK1=1 Q
.I +PSSADUC8'=PSSADUC7 S PSSADUK1=1
ADDLUN ;
I 'PSSADUK1 D ADDFLM
S PSSATYPE="ELISA UNIT(S)"
S PSSADUC2=$$FIND1^DIC(51.24,"","X",PSSATYPE,"B") I +PSSADUC2'=53 D ADDKTM S PSSADUK2=1 G ADDMIL
I $$ADDCHK() S PSSADUK2=1 G ADDLNX
I $G(^PS(51.24,53,0))'="ELISA UNIT(S)^ELISA UNIT^0" S PSSADUK2=1 G ADDLNX
K PSSADUC5,PSSADUC6,PSSADUC7,PSSADUC8
F PSSADUC5="EL UNIT;1","ELISA UNITS;2","ELISA UNIT;3","EL.U.;4","ELISA UNT;5","ELU;6" Q:PSSADUK2 D
.S PSSADUC6=$P(PSSADUC5,";"),PSSADUC7=$P(PSSADUC5,";",2)
.S PSSADUC8=$$FIND1^DIC(51.242,",53,","X",PSSADUC6,"B")
.I $$ADDCHK() S PSSADUK2=1 Q
.I +PSSADUC8'=PSSADUC7 S PSSADUK2=1
D ADDKTM
ADDMIL ;
I 'PSSADUK2 D ADDELU
S PSSATYPE="MILLIONUNIT(S)"
S PSSADUC3=$$FIND1^DIC(51.24,"","X",PSSATYPE,"B") I +PSSADUC3'=23 D ADDKTM S PSSADUK3=1 G ADDLNX
I $$ADDCHK() S PSSADUK3=1 G ADDLNX
I $G(^PS(51.24,23,0))'="MILLIONUNIT(S)^MILLIONUNIT(S)^0" S PSSADUK3=1 G ADDLNX
K PSSADUC5,PSSADUC6,PSSADUC7,PSSADUC8
F PSSADUC5="MILLION UNIT;8","MILLION UNITS;9" Q:PSSADUK3 D
.S PSSADUC6=$P(PSSADUC5,";"),PSSADUC7=$P(PSSADUC5,";",2)
.S PSSADUC8=$$FIND1^DIC(51.242,",23,","X",PSSADUC6,"B")
.I $$ADDCHK() S PSSADUK3=1 Q
.I +PSSADUC8'=PSSADUC7 S PSSADUK3=1
I 'PSSADUK3 D ADDMIL2
ADDLNX ;
I 'PSSADUK1,'PSSADUK2,'PSSADUK3 D BMES^XPDUTL("DOSE UNITS File (#51.24) entries are correct.") Q
I PSSADUK1 D ADDMS("FILM(S)")
I PSSADUK2 D ADDMS("ELISA UNIT(S)")
I PSSADUK3 D ADDMS("MILLIONUNIT(S)")
Q
;
;
ADDMS(PSSATYPE) ;
D BMES^XPDUTL("Problem found with "_PSSATYPE_" entry in DOSE UNITS File (#51.24).")
S @XPDGREF@("PSSMLMSG",PSSMXUA2)="Problem found with "_PSSATYPE_" entry in DOSE UNITS File (#51.24)." S PSSMXUA2=PSSMXUA2+1
S @XPDGREF@("PSSMLMSG",PSSMXUA2)=" " S PSSMXUA2=PSSMXUA2+1
D BMES^XPDUTL("Please log a Remedy Ticket for this issue.")
S @XPDGREF@("PSSMLMSG",PSSMXUA2)="Please log a Remedy Ticket and refer to this message." S PSSMXUA2=PSSMXUA2+1
S @XPDGREF@("PSSMLMSG",PSSMXUA2)=" " S PSSMXUA2=PSSMXUA2+1
Q
;
;
ADDCHK() ;
I $D(^TMP("DIERR",$J)) D ADDKTM Q 1
K ^TMP("DIERR",$J)
Q 0
;
;
ADDKTM ;
K ^TMP("DIERR",$J)
Q
;
;
ADDFLM ;Validate synonyms and cross references for FILM(S)
I $G(^PS(51.24,52,1,1,0))'="FILM" S PSSADUK1=1 Q
I $G(^PS(51.24,52,1,2,0))'="FILMS" S PSSADUK1=1 Q
I '$D(^PS(51.24,52,1,"B","FILM",1)) S PSSADUK1=1 Q
I '$D(^PS(51.24,52,1,"B","FILMS",2)) S PSSADUK1=1 Q
I '$D(^PS(51.24,"B","FILM(S)",52)) S PSSADUK1=1 Q
I '$D(^PS(51.24,"C","FILMS",52)) S PSSADUK1=1 Q
I '$D(^PS(51.24,"D","FILM",52,1)) S PSSADUK1=1 Q
I '$D(^PS(51.24,"D","FILMS",52,2)) S PSSADUK1=1 Q
Q
;
;
ADDELU ;Validate synonyms and cross references for ELISA UNIT(S)
I $G(^PS(51.24,53,1,1,0))'="EL UNIT" S PSSADUK2=1 Q
I $G(^PS(51.24,53,1,2,0))'="ELISA UNITS" S PSSADUK2=1 Q
I $G(^PS(51.24,53,1,3,0))'="ELISA UNIT" S PSSADUK2=1 Q
I $G(^PS(51.24,53,1,4,0))'="EL.U." S PSSADUK2=1 Q
I $G(^PS(51.24,53,1,5,0))'="ELISA UNT" S PSSADUK2=1 Q
I $G(^PS(51.24,53,1,6,0))'="ELU" S PSSADUK2=1 Q
I '$D(^PS(51.24,53,1,"B","EL UNIT",1)) S PSSADUK2=1 Q
I '$D(^PS(51.24,53,1,"B","EL.U.",4)) S PSSADUK2=1 Q
I '$D(^PS(51.24,53,1,"B","ELISA UNIT",3)) S PSSADUK2=1 Q
I '$D(^PS(51.24,53,1,"B","ELISA UNITS",2)) S PSSADUK2=1 Q
I '$D(^PS(51.24,53,1,"B","ELISA UNT",5)) S PSSADUK2=1 Q
I '$D(^PS(51.24,53,1,"B","ELU",6)) S PSSADUK2=1 Q
I '$D(^PS(51.24,"B","ELISA UNIT(S)",53)) S PSSADUK2=1 Q
I '$D(^PS(51.24,"C","ELISA UNIT",53)) S PSSADUK2=1 Q
I '$D(^PS(51.24,"D","EL UNIT",53,1)) S PSSADUK2=1 Q
I '$D(^PS(51.24,"D","EL.U.",53,4)) S PSSADUK2=1 Q
I '$D(^PS(51.24,"D","ELISA UNIT",53,3)) S PSSADUK2=1 Q
I '$D(^PS(51.24,"D","ELISA UNITS",53,2)) S PSSADUK2=1 Q
I '$D(^PS(51.24,"D","ELISA UNT",53,5)) S PSSADUK2=1 Q
I '$D(^PS(51.24,"D","ELU",53,6)) S PSSADUK2=1 Q
Q
;
SETWS ;define DOSING_INFO web service
N PSSWSERV,PSSWSER2,PSSWPEPS,PSSWSCNT,PSSWSMSG,PSSWSSTA,PSSWSERR,DA,DIE,DIC,DR,X,Y,DLAYGO S PSSWSCNT=0
S DIC="^XOB(18.12,",X="PEPS",DIC(0)="X" D ^DIC S PSSWPEPS=+Y K DIC ;find the PEPS web server IEN
D BMES^XPDUTL("Beginning DOSING_INFO Web Service definition for PEPS web server: ")
S @XPDGREF@("PSSMLMSG",PSSMXUA2)="Beginning DOSING_INFO Web Service definition: " S PSSMXUA2=PSSMXUA2+1
I PSSWPEPS=-1 D G SETWSQT
.D BMES^XPDUTL(" PEPS Web Server is not defined. Please contact product support.") S PSSWSERR=1
.S @XPDGREF@("PSSMLMSG",PSSMXUA2)=" PEPS Web Server isn't defined and DOSING_INFO Web Service couldn't be" S PSSMXUA2=PSSMXUA2+1
.S @XPDGREF@("PSSMLMSG",PSSMXUA2)=" created. Please log a Remedy Ticket and refer to this message." S PSSMXUA2=PSSMXUA2+1
SETWS2 ;
S DIC="^XOB(18.02,",X="DOSING_INFO",DIC(0)="X" D ^DIC S PSSWSERV=+Y ;get the IEN for the DOSING_INFO web service
I +Y<1,PSSWSCNT=0 D REGREST^XOBWLIB("DOSING_INFO","/MOCHA/","dosinginfo") H 3 S PSSWSCNT=1 G SETWS2 ;if not there register the web service
I +Y<1 D H 3 G SETWSQT
.D BMES^XPDUTL(" DOSING_INFO web service has NOT been created. Please contact product support.")
.S @XPDGREF@("PSSMLMSG",PSSMXUA2)=" DOSING_INFO web service has NOT been defined. Please log a" S PSSMXUA2=PSSMXUA2+1,PSSWSERR=1
.S @XPDGREF@("PSSMLMSG",PSSMXUA2)=" Remedy Ticket and refer to this message." S PSSMXUA2=PSSMXUA2+1
.S @XPDGREF@("PSSMLMSG",PSSMXUA2)=" " S PSSMXUA2=PSSMXUA2+1
S PSSWSMSG=$S(PSSWSCNT=0:"DOSING_INFO web service was previously defined. No action taken.",1:"DOSING_INFO web service has been defined.")
S @XPDGREF@("PSSMLMSG",PSSMXUA2)=" "_PSSWSMSG S PSSMXUA2=PSSMXUA2+1
D BMES^XPDUTL(" "_PSSWSMSG)
;
K DIC,DIE,DA,DR,X,Y
S DIC="^XOB(18.12,"_PSSWPEPS_",100,",X="DOSING_INFO",DIC(0)="X" D ^DIC S PSSWSER2=+Y
L +^XOB(18.12,PSSWPEPS):20 I '$T D H 3 G SETWSQT
.D BMES^XPDUTL(" Unable to lock file 18.12 to enable DOSING_INFO web service. Please ")
.D BMES^XPDUTL(" contact product support.")
.S @XPDGREF@("PSSMLMSG",PSSMXUA2)=" Unable to lock file 18.12 to enable DOSING_INFO web service." S PSSMXUA2=PSSMXUA2+1
.S @XPDGREF@("PSSMLMSG",PSSMXUA2)=" Please log a Remedy Ticket and refer to this message." S PSSMXUA2=PSSMXUA2+1,PSSWSERR=1
I PSSWSER2=-1 D PSSENABL G SETWSQT
S PSSWSSTA=$$GET1^DIQ(18.121,PSSWSER2_",1",".06","I")
I PSSWSSTA=-1 D PSSENABL G SETWSQT
I PSSWSSTA=""!(PSSWSSTA=0) D PSSENAB2 G SETWSQT
I PSSWSSTA D
.D BMES^XPDUTL(" DOSING_INFO web service was previously enabled. No action taken.")
.S @XPDGREF@("PSSMLMSG",PSSMXUA2)=" DOSING_INFO web service was previously enabled. No action taken." S PSSMXUA2=PSSMXUA2+1
SETWSQT ;
L -^XOB(18.12,PSSWPEPS)
I $G(PSSWSERR) D
.D BMES^XPDUTL(" **************************************************************************")
.D BMES^XPDUTL(" ** Due to error(s), DOSING_INFO web service definition is not complete. **")
.D BMES^XPDUTL(" **************************************************************************")
.S @XPDGREF@("PSSMLMSG",PSSMXUA2)="*** Due to error(s), DOSING_INFO web service definition is not complete." S PSSMXUA2=PSSMXUA2+1
I '$G(PSSWSERR) D BMES^XPDUTL("Web Service definition process is complete for PEPS web server.") D
.S @XPDGREF@("PSSMLMSG",PSSMXUA2)="Web Service definition process is complete." S PSSMXUA2=PSSMXUA2+1
D LINE
Q
;
PSSENABL ;
S DIC="^XOB(18.12,"_PSSWPEPS_",100,",DLAYGO=18.121,DIC(0)="L",DA(1)=PSSWPEPS,X="DOSING_INFO" D ^DIC S PSSWSER2=+Y
PSSENAB2 ;
S DIE="^XOB(18.12,"_PSSWPEPS_",100,",DR=".06///ENABLE",DA(1)=PSSWPEPS,DA=PSSWSER2 D ^DIE
S PSSWSSTA=$$GET1^DIQ(18.121,PSSWSER2_",1",".06","I")
I PSSWSSTA D
.D BMES^XPDUTL(" DOSING_INFO web service has been enabled.")
.S @XPDGREF@("PSSMLMSG",PSSMXUA2)=" DOSING_INFO web service has been enabled." S PSSMXUA2=PSSMXUA2+1
Q
;
LINE ;
S @XPDGREF@("PSSMLMSG",PSSMXUA2)=" " S PSSMXUA2=PSSMXUA2+1
Q
;
ADDMIL2 ;
I $G(^PS(51.24,23,1,1,0))'="MU" S PSSADUK3=1 Q
I $G(^PS(51.24,23,1,2,0))'="MIU" S PSSADUK3=1 Q
I $G(^PS(51.24,23,1,3,0))'="MILU" S PSSADUK3=1 Q
I $G(^PS(51.24,23,1,4,0))'="MILI U" S PSSADUK3=1 Q
I $G(^PS(51.24,23,1,5,0))'="MILI UNIT" S PSSADUK3=1 Q
I $G(^PS(51.24,23,1,6,0))'="MILI UNITS" S PSSADUK3=1 Q
I $G(^PS(51.24,23,1,7,0))'="MILLION UNT" S PSSADUK3=1 Q
I $G(^PS(51.24,23,1,8,0))'="MILLION UNIT" S PSSADUK3=1 Q
I $G(^PS(51.24,23,1,9,0))'="MILLION UNITS" S PSSADUK3=1 Q
I '$D(^PS(51.24,23,1,"B","MILI U",4)) S PSSADUK3=1 Q
I '$D(^PS(51.24,23,1,"B","MILI UNIT",5)) S PSSADUK3=1 Q
I '$D(^PS(51.24,23,1,"B","MILI UNITS",6)) S PSSADUK3=1 Q
I '$D(^PS(51.24,23,1,"B","MILLION UNIT",8)) S PSSADUK3=1 Q
I '$D(^PS(51.24,23,1,"B","MILLION UNITS",9)) S PSSADUK3=1 Q
I '$D(^PS(51.24,23,1,"B","MILLION UNT",7)) S PSSADUK3=1 Q
I '$D(^PS(51.24,23,1,"B","MILU",3)) S PSSADUK3=1 Q
I '$D(^PS(51.24,23,1,"B","MIU",2)) S PSSADUK3=1 Q
I '$D(^PS(51.24,23,1,"B","MU",1)) S PSSADUK3=1 Q
I '$D(^PS(51.24,"B","MILLIONUNIT(S)",23)) S PSSADUK3=1 Q
I '$D(^PS(51.24,"C","MILLIONUNIT(S)",23)) S PSSADUK3=1 Q
I '$D(^PS(51.24,"D","MILI U",23,4)) S PSSADUK3=1 Q
I '$D(^PS(51.24,"D","MILI UNIT",23,5)) S PSSADUK3=1 Q
I '$D(^PS(51.24,"D","MILI UNITS",23,6)) S PSSADUK3=1 Q
I '$D(^PS(51.24,"D","MILLION UNIT",23,8)) S PSSADUK3=1 Q
I '$D(^PS(51.24,"D","MILLION UNITS",23,9)) S PSSADUK3=1 Q
I '$D(^PS(51.24,"D","MILLION UNT",23,7)) S PSSADUK3=1 Q
I '$D(^PS(51.24,"D","MILU",23,3)) S PSSADUK3=1 Q
I '$D(^PS(51.24,"D","MIU",23,2)) S PSSADUK3=1 Q
I '$D(^PS(51.24,"D","MU",23,1)) S PSSADUK3=1 Q
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSS160PO 12867 printed Dec 13, 2024@02:29:14 Page 2
PSS160PO ;BIR/RTR-Post Install routine for patch PSS*1*160 ;02/18/11
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**160**;9/30/97;Build 76
+2 ;External reference to ^XOB(18.02 supported by DBIA 5814
+3 ;External reference to ^XOB(18.12 supported by DBIA 5813
+4 ;
+5 ;
EN ;Do Mail Message
+1 NEW PSSMXUA1,PSSMXUA2
SET PSSMXUA2=0
+2 FOR PSSMXUA1=0:0
SET PSSMXUA1=$ORDER(@XPDGREF@("PSSMLMSG",PSSMXUA1))
if 'PSSMXUA1
QUIT
SET PSSMXUA2=PSSMXUA2+1
+3 SET PSSMXUA2=PSSMXUA2+1
+4 DO ADDVAL
DO MNUADD
DO SETWS
+5 DO BMES^XPDUTL("Generating Mail Message....")
EN2 ;
+1 DO MAIL
DO BMES^XPDUTL("Mail message sent.")
+2 IF $PIECE($GET(^PS(59.7,1,81)),"^")=""
SET $PIECE(^PS(59.7,1,81),"^")=1
+3 QUIT
+4 ;
+5 ;
MAIL ;Send mail message
+1 NEW PSS60REC,PSS60PLP,XMTEXT,XMY,XMSUB,XMDUZ,XMMG,XMSTRIP,XMROU,XMYBLOB,XMZ,XMDUN
+2 KILL ^TMP($JOB,"PSS60PTX")
+3 FOR PSS60PLP=0:0
SET PSS60PLP=$ORDER(@XPDGREF@("PSSMLMSG",PSS60PLP))
if 'PSS60PLP
QUIT
SET ^TMP($JOB,"PSS60PTX",PSS60PLP)=@XPDGREF@("PSSMLMSG",PSS60PLP)
+4 SET XMSUB="PSS*1*160 Installation Complete"
+5 SET XMDUZ="PSS*1*160 Install"
+6 SET XMTEXT="^TMP($J,""PSS60PTX"","
+7 SET PSS60REC=""
FOR
SET PSS60REC=$ORDER(@XPDGREF@("PSSMLMDZ",PSS60REC))
if PSS60REC=""
QUIT
SET XMY(PSS60REC)=""
+8 NEW DIFROM
DO ^XMD
+9 KILL ^TMP($JOB,"PSS60PTX")
+10 QUIT
+11 ;
+12 ;
MNUADD ;Add PSS DRUG DOSING LOOKUP option to PSS DOSAGE MANAGEMENT menu option
+1 DO BMES^XPDUTL("Linking New PSS DRUG DOSING LOOKUP Option....")
+2 NEW PSSMXUA,PSSMXUAF
+3 SET PSSMXUAF=0
+4 KILL PSSMXUA
SET PSSMXUA=$$ADD^XPDMENU("PSS DOSAGES MANAGEMENT","PSS DRUG DOSING LOOKUP",,9)
IF 'PSSMXUA
Begin DoDot:1
+5 SET PSSMXUAF=1
+6 DO BMES^XPDUTL("Unable to link PSS DRUG DOSING LOOKUP Option....")
DO BMES^XPDUTL("Please log a Remedy Ticket for this issue.")
+7 SET @XPDGREF@("PSSMLMSG",PSSMXUA2)="Unable to link PSS DRUG DOSING LOOKUP Option to PSS DOSAGES MANAGEMENT Menu"
SET PSSMXUA2=PSSMXUA2+1
+8 SET @XPDGREF@("PSSMLMSG",PSSMXUA2)=" "
SET PSSMXUA2=PSSMXUA2+1
SET @XPDGREF@("PSSMLMSG",PSSMXUA2)="Please log a Remedy Ticket and refer to this message."
SET PSSMXUA2=PSSMXUA2+1
DO LINE
End DoDot:1
+9 IF 'PSSMXUAF
DO BMES^XPDUTL("New PSS DRUG DOSING LOOKUP option linked successfully...")
+10 ;
+11 DO BMES^XPDUTL("Linking New PSS TRAILING SPACES REPORT Option....")
+12 KILL PSSMXUA,PSSMXUAF
+13 SET PSSMXUAF=0
+14 SET PSSMXUA=$$ADD^XPDMENU("PSS DOSAGES MANAGEMENT","PSS TRAILING SPACES REPORT",,10)
IF 'PSSMXUA
Begin DoDot:1
+15 SET PSSMXUAF=1
+16 DO BMES^XPDUTL("Unable to link PSS TRAILING SPACES REPORT Option....")
DO BMES^XPDUTL("Please log a Remedy Ticket for this issue.")
+17 SET @XPDGREF@("PSSMLMSG",PSSMXUA2)="Unable to link PSS TRAILING SPACES REPORT Option to PSS DOSAGES MANAGEMENT Menu"
SET PSSMXUA2=PSSMXUA2+1
+18 SET @XPDGREF@("PSSMLMSG",PSSMXUA2)=" "
SET PSSMXUA2=PSSMXUA2+1
SET @XPDGREF@("PSSMLMSG",PSSMXUA2)="Please log a Remedy Ticket and refer to this message."
SET PSSMXUA2=PSSMXUA2+1
DO LINE
End DoDot:1
+19 IF 'PSSMXUAF
DO BMES^XPDUTL("New PSS TRAILING SPACES REPORT option linked successfully...")
+20 QUIT
+21 ;
+22 ;
ADDVAL ; Final validation of data
+1 DO BMES^XPDUTL("Validating new Dose Unit File (#51.24) entries.")
+2 NEW PSSADUC1,PSSADUC2,PSSADUC5,PSSADUC6,PSSADUC7,PSSADUC8,PSSADUK1,PSSADUK2,PSSADUK3,PSSATYPE
+3 SET (PSSADUK1,PSSADUK2,PSSADUK3)=0
SET PSSATYPE="FILM(S)"
+4 SET PSSADUC1=$$FIND1^DIC(51.24,"","X",PSSATYPE,"B")
IF +PSSADUC1'=52
DO ADDKTM
SET PSSADUK1=1
GOTO ADDLUN
+5 IF $$ADDCHK()
SET PSSADUK1=1
GOTO ADDLUN
+6 IF $GET(^PS(51.24,52,0))'="FILM(S)^FILMS^1"
SET PSSADUK1=1
GOTO ADDLUN
+7 FOR PSSADUC5="FILM;1","FILMS;2"
if PSSADUK1
QUIT
Begin DoDot:1
+8 SET PSSADUC6=$PIECE(PSSADUC5,";")
SET PSSADUC7=$PIECE(PSSADUC5,";",2)
+9 SET PSSADUC8=$$FIND1^DIC(51.242,",52,","X",PSSADUC6,"B")
+10 IF $$ADDCHK()
SET PSSADUK1=1
QUIT
+11 IF +PSSADUC8'=PSSADUC7
SET PSSADUK1=1
End DoDot:1
ADDLUN ;
+1 IF 'PSSADUK1
DO ADDFLM
+2 SET PSSATYPE="ELISA UNIT(S)"
+3 SET PSSADUC2=$$FIND1^DIC(51.24,"","X",PSSATYPE,"B")
IF +PSSADUC2'=53
DO ADDKTM
SET PSSADUK2=1
GOTO ADDMIL
+4 IF $$ADDCHK()
SET PSSADUK2=1
GOTO ADDLNX
+5 IF $GET(^PS(51.24,53,0))'="ELISA UNIT(S)^ELISA UNIT^0"
SET PSSADUK2=1
GOTO ADDLNX
+6 KILL PSSADUC5,PSSADUC6,PSSADUC7,PSSADUC8
+7 FOR PSSADUC5="EL UNIT;1","ELISA UNITS;2","ELISA UNIT;3","EL.U.;4","ELISA UNT;5","ELU;6"
if PSSADUK2
QUIT
Begin DoDot:1
+8 SET PSSADUC6=$PIECE(PSSADUC5,";")
SET PSSADUC7=$PIECE(PSSADUC5,";",2)
+9 SET PSSADUC8=$$FIND1^DIC(51.242,",53,","X",PSSADUC6,"B")
+10 IF $$ADDCHK()
SET PSSADUK2=1
QUIT
+11 IF +PSSADUC8'=PSSADUC7
SET PSSADUK2=1
End DoDot:1
+12 DO ADDKTM
ADDMIL ;
+1 IF 'PSSADUK2
DO ADDELU
+2 SET PSSATYPE="MILLIONUNIT(S)"
+3 SET PSSADUC3=$$FIND1^DIC(51.24,"","X",PSSATYPE,"B")
IF +PSSADUC3'=23
DO ADDKTM
SET PSSADUK3=1
GOTO ADDLNX
+4 IF $$ADDCHK()
SET PSSADUK3=1
GOTO ADDLNX
+5 IF $GET(^PS(51.24,23,0))'="MILLIONUNIT(S)^MILLIONUNIT(S)^0"
SET PSSADUK3=1
GOTO ADDLNX
+6 KILL PSSADUC5,PSSADUC6,PSSADUC7,PSSADUC8
+7 FOR PSSADUC5="MILLION UNIT;8","MILLION UNITS;9"
if PSSADUK3
QUIT
Begin DoDot:1
+8 SET PSSADUC6=$PIECE(PSSADUC5,";")
SET PSSADUC7=$PIECE(PSSADUC5,";",2)
+9 SET PSSADUC8=$$FIND1^DIC(51.242,",23,","X",PSSADUC6,"B")
+10 IF $$ADDCHK()
SET PSSADUK3=1
QUIT
+11 IF +PSSADUC8'=PSSADUC7
SET PSSADUK3=1
End DoDot:1
+12 IF 'PSSADUK3
DO ADDMIL2
ADDLNX ;
+1 IF 'PSSADUK1
IF 'PSSADUK2
IF 'PSSADUK3
DO BMES^XPDUTL("DOSE UNITS File (#51.24) entries are correct.")
QUIT
+2 IF PSSADUK1
DO ADDMS("FILM(S)")
+3 IF PSSADUK2
DO ADDMS("ELISA UNIT(S)")
+4 IF PSSADUK3
DO ADDMS("MILLIONUNIT(S)")
+5 QUIT
+6 ;
+7 ;
ADDMS(PSSATYPE) ;
+1 DO BMES^XPDUTL("Problem found with "_PSSATYPE_" entry in DOSE UNITS File (#51.24).")
+2 SET @XPDGREF@("PSSMLMSG",PSSMXUA2)="Problem found with "_PSSATYPE_" entry in DOSE UNITS File (#51.24)."
SET PSSMXUA2=PSSMXUA2+1
+3 SET @XPDGREF@("PSSMLMSG",PSSMXUA2)=" "
SET PSSMXUA2=PSSMXUA2+1
+4 DO BMES^XPDUTL("Please log a Remedy Ticket for this issue.")
+5 SET @XPDGREF@("PSSMLMSG",PSSMXUA2)="Please log a Remedy Ticket and refer to this message."
SET PSSMXUA2=PSSMXUA2+1
+6 SET @XPDGREF@("PSSMLMSG",PSSMXUA2)=" "
SET PSSMXUA2=PSSMXUA2+1
+7 QUIT
+8 ;
+9 ;
ADDCHK() ;
+1 IF $DATA(^TMP("DIERR",$JOB))
DO ADDKTM
QUIT 1
+2 KILL ^TMP("DIERR",$JOB)
+3 QUIT 0
+4 ;
+5 ;
ADDKTM ;
+1 KILL ^TMP("DIERR",$JOB)
+2 QUIT
+3 ;
+4 ;
ADDFLM ;Validate synonyms and cross references for FILM(S)
+1 IF $GET(^PS(51.24,52,1,1,0))'="FILM"
SET PSSADUK1=1
QUIT
+2 IF $GET(^PS(51.24,52,1,2,0))'="FILMS"
SET PSSADUK1=1
QUIT
+3 IF '$DATA(^PS(51.24,52,1,"B","FILM",1))
SET PSSADUK1=1
QUIT
+4 IF '$DATA(^PS(51.24,52,1,"B","FILMS",2))
SET PSSADUK1=1
QUIT
+5 IF '$DATA(^PS(51.24,"B","FILM(S)",52))
SET PSSADUK1=1
QUIT
+6 IF '$DATA(^PS(51.24,"C","FILMS",52))
SET PSSADUK1=1
QUIT
+7 IF '$DATA(^PS(51.24,"D","FILM",52,1))
SET PSSADUK1=1
QUIT
+8 IF '$DATA(^PS(51.24,"D","FILMS",52,2))
SET PSSADUK1=1
QUIT
+9 QUIT
+10 ;
+11 ;
ADDELU ;Validate synonyms and cross references for ELISA UNIT(S)
+1 IF $GET(^PS(51.24,53,1,1,0))'="EL UNIT"
SET PSSADUK2=1
QUIT
+2 IF $GET(^PS(51.24,53,1,2,0))'="ELISA UNITS"
SET PSSADUK2=1
QUIT
+3 IF $GET(^PS(51.24,53,1,3,0))'="ELISA UNIT"
SET PSSADUK2=1
QUIT
+4 IF $GET(^PS(51.24,53,1,4,0))'="EL.U."
SET PSSADUK2=1
QUIT
+5 IF $GET(^PS(51.24,53,1,5,0))'="ELISA UNT"
SET PSSADUK2=1
QUIT
+6 IF $GET(^PS(51.24,53,1,6,0))'="ELU"
SET PSSADUK2=1
QUIT
+7 IF '$DATA(^PS(51.24,53,1,"B","EL UNIT",1))
SET PSSADUK2=1
QUIT
+8 IF '$DATA(^PS(51.24,53,1,"B","EL.U.",4))
SET PSSADUK2=1
QUIT
+9 IF '$DATA(^PS(51.24,53,1,"B","ELISA UNIT",3))
SET PSSADUK2=1
QUIT
+10 IF '$DATA(^PS(51.24,53,1,"B","ELISA UNITS",2))
SET PSSADUK2=1
QUIT
+11 IF '$DATA(^PS(51.24,53,1,"B","ELISA UNT",5))
SET PSSADUK2=1
QUIT
+12 IF '$DATA(^PS(51.24,53,1,"B","ELU",6))
SET PSSADUK2=1
QUIT
+13 IF '$DATA(^PS(51.24,"B","ELISA UNIT(S)",53))
SET PSSADUK2=1
QUIT
+14 IF '$DATA(^PS(51.24,"C","ELISA UNIT",53))
SET PSSADUK2=1
QUIT
+15 IF '$DATA(^PS(51.24,"D","EL UNIT",53,1))
SET PSSADUK2=1
QUIT
+16 IF '$DATA(^PS(51.24,"D","EL.U.",53,4))
SET PSSADUK2=1
QUIT
+17 IF '$DATA(^PS(51.24,"D","ELISA UNIT",53,3))
SET PSSADUK2=1
QUIT
+18 IF '$DATA(^PS(51.24,"D","ELISA UNITS",53,2))
SET PSSADUK2=1
QUIT
+19 IF '$DATA(^PS(51.24,"D","ELISA UNT",53,5))
SET PSSADUK2=1
QUIT
+20 IF '$DATA(^PS(51.24,"D","ELU",53,6))
SET PSSADUK2=1
QUIT
+21 QUIT
+22 ;
SETWS ;define DOSING_INFO web service
+1 NEW PSSWSERV,PSSWSER2,PSSWPEPS,PSSWSCNT,PSSWSMSG,PSSWSSTA,PSSWSERR,DA,DIE,DIC,DR,X,Y,DLAYGO
SET PSSWSCNT=0
+2 ;find the PEPS web server IEN
SET DIC="^XOB(18.12,"
SET X="PEPS"
SET DIC(0)="X"
DO ^DIC
SET PSSWPEPS=+Y
KILL DIC
+3 DO BMES^XPDUTL("Beginning DOSING_INFO Web Service definition for PEPS web server: ")
+4 SET @XPDGREF@("PSSMLMSG",PSSMXUA2)="Beginning DOSING_INFO Web Service definition: "
SET PSSMXUA2=PSSMXUA2+1
+5 IF PSSWPEPS=-1
Begin DoDot:1
+6 DO BMES^XPDUTL(" PEPS Web Server is not defined. Please contact product support.")
SET PSSWSERR=1
+7 SET @XPDGREF@("PSSMLMSG",PSSMXUA2)=" PEPS Web Server isn't defined and DOSING_INFO Web Service couldn't be"
SET PSSMXUA2=PSSMXUA2+1
+8 SET @XPDGREF@("PSSMLMSG",PSSMXUA2)=" created. Please log a Remedy Ticket and refer to this message."
SET PSSMXUA2=PSSMXUA2+1
End DoDot:1
GOTO SETWSQT
SETWS2 ;
+1 ;get the IEN for the DOSING_INFO web service
SET DIC="^XOB(18.02,"
SET X="DOSING_INFO"
SET DIC(0)="X"
DO ^DIC
SET PSSWSERV=+Y
+2 ;if not there register the web service
IF +Y<1
IF PSSWSCNT=0
DO REGREST^XOBWLIB("DOSING_INFO","/MOCHA/","dosinginfo")
HANG 3
SET PSSWSCNT=1
GOTO SETWS2
+3 IF +Y<1
Begin DoDot:1
+4 DO BMES^XPDUTL(" DOSING_INFO web service has NOT been created. Please contact product support.")
+5 SET @XPDGREF@("PSSMLMSG",PSSMXUA2)=" DOSING_INFO web service has NOT been defined. Please log a"
SET PSSMXUA2=PSSMXUA2+1
SET PSSWSERR=1
+6 SET @XPDGREF@("PSSMLMSG",PSSMXUA2)=" Remedy Ticket and refer to this message."
SET PSSMXUA2=PSSMXUA2+1
+7 SET @XPDGREF@("PSSMLMSG",PSSMXUA2)=" "
SET PSSMXUA2=PSSMXUA2+1
End DoDot:1
HANG 3
GOTO SETWSQT
+8 SET PSSWSMSG=$SELECT(PSSWSCNT=0:"DOSING_INFO web service was previously defined. No action taken.",1:"DOSING_INFO web service has been defined.")
+9 SET @XPDGREF@("PSSMLMSG",PSSMXUA2)=" "_PSSWSMSG
SET PSSMXUA2=PSSMXUA2+1
+10 DO BMES^XPDUTL(" "_PSSWSMSG)
+11 ;
+12 KILL DIC,DIE,DA,DR,X,Y
+13 SET DIC="^XOB(18.12,"_PSSWPEPS_",100,"
SET X="DOSING_INFO"
SET DIC(0)="X"
DO ^DIC
SET PSSWSER2=+Y
+14 LOCK +^XOB(18.12,PSSWPEPS):20
IF '$TEST
Begin DoDot:1
+15 DO BMES^XPDUTL(" Unable to lock file 18.12 to enable DOSING_INFO web service. Please ")
+16 DO BMES^XPDUTL(" contact product support.")
+17 SET @XPDGREF@("PSSMLMSG",PSSMXUA2)=" Unable to lock file 18.12 to enable DOSING_INFO web service."
SET PSSMXUA2=PSSMXUA2+1
+18 SET @XPDGREF@("PSSMLMSG",PSSMXUA2)=" Please log a Remedy Ticket and refer to this message."
SET PSSMXUA2=PSSMXUA2+1
SET PSSWSERR=1
End DoDot:1
HANG 3
GOTO SETWSQT
+19 IF PSSWSER2=-1
DO PSSENABL
GOTO SETWSQT
+20 SET PSSWSSTA=$$GET1^DIQ(18.121,PSSWSER2_",1",".06","I")
+21 IF PSSWSSTA=-1
DO PSSENABL
GOTO SETWSQT
+22 IF PSSWSSTA=""!(PSSWSSTA=0)
DO PSSENAB2
GOTO SETWSQT
+23 IF PSSWSSTA
Begin DoDot:1
+24 DO BMES^XPDUTL(" DOSING_INFO web service was previously enabled. No action taken.")
+25 SET @XPDGREF@("PSSMLMSG",PSSMXUA2)=" DOSING_INFO web service was previously enabled. No action taken."
SET PSSMXUA2=PSSMXUA2+1
End DoDot:1
SETWSQT ;
+1 LOCK -^XOB(18.12,PSSWPEPS)
+2 IF $GET(PSSWSERR)
Begin DoDot:1
+3 DO BMES^XPDUTL(" **************************************************************************")
+4 DO BMES^XPDUTL(" ** Due to error(s), DOSING_INFO web service definition is not complete. **")
+5 DO BMES^XPDUTL(" **************************************************************************")
+6 SET @XPDGREF@("PSSMLMSG",PSSMXUA2)="*** Due to error(s), DOSING_INFO web service definition is not complete."
SET PSSMXUA2=PSSMXUA2+1
End DoDot:1
+7 IF '$GET(PSSWSERR)
DO BMES^XPDUTL("Web Service definition process is complete for PEPS web server.")
Begin DoDot:1
+8 SET @XPDGREF@("PSSMLMSG",PSSMXUA2)="Web Service definition process is complete."
SET PSSMXUA2=PSSMXUA2+1
End DoDot:1
+9 DO LINE
+10 QUIT
+11 ;
PSSENABL ;
+1 SET DIC="^XOB(18.12,"_PSSWPEPS_",100,"
SET DLAYGO=18.121
SET DIC(0)="L"
SET DA(1)=PSSWPEPS
SET X="DOSING_INFO"
DO ^DIC
SET PSSWSER2=+Y
PSSENAB2 ;
+1 SET DIE="^XOB(18.12,"_PSSWPEPS_",100,"
SET DR=".06///ENABLE"
SET DA(1)=PSSWPEPS
SET DA=PSSWSER2
DO ^DIE
+2 SET PSSWSSTA=$$GET1^DIQ(18.121,PSSWSER2_",1",".06","I")
+3 IF PSSWSSTA
Begin DoDot:1
+4 DO BMES^XPDUTL(" DOSING_INFO web service has been enabled.")
+5 SET @XPDGREF@("PSSMLMSG",PSSMXUA2)=" DOSING_INFO web service has been enabled."
SET PSSMXUA2=PSSMXUA2+1
End DoDot:1
+6 QUIT
+7 ;
LINE ;
+1 SET @XPDGREF@("PSSMLMSG",PSSMXUA2)=" "
SET PSSMXUA2=PSSMXUA2+1
+2 QUIT
+3 ;
ADDMIL2 ;
+1 IF $GET(^PS(51.24,23,1,1,0))'="MU"
SET PSSADUK3=1
QUIT
+2 IF $GET(^PS(51.24,23,1,2,0))'="MIU"
SET PSSADUK3=1
QUIT
+3 IF $GET(^PS(51.24,23,1,3,0))'="MILU"
SET PSSADUK3=1
QUIT
+4 IF $GET(^PS(51.24,23,1,4,0))'="MILI U"
SET PSSADUK3=1
QUIT
+5 IF $GET(^PS(51.24,23,1,5,0))'="MILI UNIT"
SET PSSADUK3=1
QUIT
+6 IF $GET(^PS(51.24,23,1,6,0))'="MILI UNITS"
SET PSSADUK3=1
QUIT
+7 IF $GET(^PS(51.24,23,1,7,0))'="MILLION UNT"
SET PSSADUK3=1
QUIT
+8 IF $GET(^PS(51.24,23,1,8,0))'="MILLION UNIT"
SET PSSADUK3=1
QUIT
+9 IF $GET(^PS(51.24,23,1,9,0))'="MILLION UNITS"
SET PSSADUK3=1
QUIT
+10 IF '$DATA(^PS(51.24,23,1,"B","MILI U",4))
SET PSSADUK3=1
QUIT
+11 IF '$DATA(^PS(51.24,23,1,"B","MILI UNIT",5))
SET PSSADUK3=1
QUIT
+12 IF '$DATA(^PS(51.24,23,1,"B","MILI UNITS",6))
SET PSSADUK3=1
QUIT
+13 IF '$DATA(^PS(51.24,23,1,"B","MILLION UNIT",8))
SET PSSADUK3=1
QUIT
+14 IF '$DATA(^PS(51.24,23,1,"B","MILLION UNITS",9))
SET PSSADUK3=1
QUIT
+15 IF '$DATA(^PS(51.24,23,1,"B","MILLION UNT",7))
SET PSSADUK3=1
QUIT
+16 IF '$DATA(^PS(51.24,23,1,"B","MILU",3))
SET PSSADUK3=1
QUIT
+17 IF '$DATA(^PS(51.24,23,1,"B","MIU",2))
SET PSSADUK3=1
QUIT
+18 IF '$DATA(^PS(51.24,23,1,"B","MU",1))
SET PSSADUK3=1
QUIT
+19 IF '$DATA(^PS(51.24,"B","MILLIONUNIT(S)",23))
SET PSSADUK3=1
QUIT
+20 IF '$DATA(^PS(51.24,"C","MILLIONUNIT(S)",23))
SET PSSADUK3=1
QUIT
+21 IF '$DATA(^PS(51.24,"D","MILI U",23,4))
SET PSSADUK3=1
QUIT
+22 IF '$DATA(^PS(51.24,"D","MILI UNIT",23,5))
SET PSSADUK3=1
QUIT
+23 IF '$DATA(^PS(51.24,"D","MILI UNITS",23,6))
SET PSSADUK3=1
QUIT
+24 IF '$DATA(^PS(51.24,"D","MILLION UNIT",23,8))
SET PSSADUK3=1
QUIT
+25 IF '$DATA(^PS(51.24,"D","MILLION UNITS",23,9))
SET PSSADUK3=1
QUIT
+26 IF '$DATA(^PS(51.24,"D","MILLION UNT",23,7))
SET PSSADUK3=1
QUIT
+27 IF '$DATA(^PS(51.24,"D","MILU",23,3))
SET PSSADUK3=1
QUIT
+28 IF '$DATA(^PS(51.24,"D","MIU",23,2))
SET PSSADUK3=1
QUIT
+29 IF '$DATA(^PS(51.24,"D","MU",23,1))
SET PSSADUK3=1
QUIT
+30 QUIT
+31 ;
