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

PSXUTL.m

Go to the documentation of this file.
  1. PSXUTL ;BIR/BAB,WPB,HTW-Utility Subroutines ;14 Feb 2002 2:27 PM
  1. ;;2.0;CMOP;**3,38**;11 Apr 97
  1. ;Reference to ^PS(54 supported by DBIA #2227
  1. ;Reference to ^PSDRUG( supported by DBIA #1983
  1. ;
  1. HEX ;converts decimal #<128 to a two byte hex #
  1. ;requires PSXHEX = decimal # to be converted
  1. ;returns PSXHEX = hex #, if error PSXHEX=""
  1. N %,H,H1,H2 S %=PSXHEX
  1. I (%<0)!(%>127)!(%'=+%) S PSXHEX="" Q ;error if # not between 0 - 127
  1. I %<10 S PSXHEX=0_% Q ;if # < 10 result is trivial, pad with zero
  1. S H=%\16 S:H>9 H=$E(" ABCDEF",H) S H1=H
  1. S H=%#16 S:H>9 H=$E(" ABCDEF",H) S H2=H
  1. S PSXHEX=H1_H2
  1. Q
  1. FLUSH1 N X,X1,X2,N S N=0
  1. ; the *READ is for the CMOP vendors CPU only
  1. S X=$P($H,",",2) F R *X2:0 Q:'$T S N=N+1 S X1=$P($H,",",2) S:X1<X X1=X1+86400 Q:(X1-X)>20
  1. Q
  1. ;check to see if a timer has expired
  1. ;requires PSXTM = PSXTMx where x is A, B, D or E
  1. ;returns PSXTMOUT=1 if timer has expired, otherwise PSXTMOUT=0
  1. CHKA S DELTA=PSXDLTA,PSXTM=PSXTMA G CHK
  1. CHKB S DELTA=PSXDLTB,PSXTM=PSXTMB G CHK
  1. CHKD S DELTA=PSXDLTD,PSXTM=PSXTMD G CHK
  1. CHKE S DELTA=PSXDLTE,PSXTM=PSXTME
  1. CHK N %
  1. S %=$P($H,",",2) S:%<PSXTM %=%+86400
  1. S PSXTMOUT=$S(%'>(PSXTM+DELTA):0,1:1)
  1. K DELTA
  1. Q
  1. LOG ;create a log entry in the CMOP INTERFACE file
  1. ;requires the LOG() array with the text of the MESSAGE
  1. N X,Y
  1. H 1
  1. D NOW^%DTC K %I,%H
  1. K DIC,DD,DO
  1. S X=%,DINUM=9999999-X,DIC="^PSX(553,"_1_",""X"",",DIC(0)="Z"
  1. D FILE^DICN G:$P(Y,"^",3)'=1 LOG
  1. L +^PSX(553,1,"S"):DTIME Q:'$T
  1. S X="" F %=1:1 S X=$O(LOG(X)) Q:'X S ^PSX(553,1,"X",+Y,"X",%,0)=LOG(X)
  1. S %=%-1,^PSX(553,1,"X",+Y,"X",0)="^^"_%_"^"_%_"^"_$P(+Y(0),".")
  1. L -^PSX(553,1,"S")
  1. K DD,DO,DUOUT,DTOUT,X,Y,DIC,DINUM,%,DLAYGO
  1. Q
  1. TSOUT ;convert current date time to HL7 timestamp
  1. ;returns PSXTS= YYYYMMDDHHMM
  1. D NOW^%DTC
  1. S %=$E($P(%,".",2),1,6)
  1. S PSXTS=(1700+$E(X,1,3))_$E(X,4,7)_%_$E("0000",1,4-$L(%))
  1. K %,%H,%I
  1. Q
  1. TSIN ;convert an HL7 timestamp to fileman format
  1. ;returns e.g. PSXFM=2910305.213
  1. ;requires PSXTS as input with YYYYMMDDHHMM format
  1. I $G(PSXTS)']""!($L(PSXTS)<7) S PSXFM=""
  1. N X S X=$E(PSXTS,9,14) S PSXFM=$E(PSXTS,1,2)-17_$E(PSXTS,3,8)_$S(+X:+("."_X),1:"")
  1. Q
  1. STATUS ;display CMOP status for entry action on RX menu
  1. N PSXSTAT,PSXTXT
  1. S PSXSTAT=$G(^PSX(553,1,"S"))
  1. Q:$G(PSXSTAT)=""
  1. S PSXTXT="CMOP Interface is "_$S(PSXSTAT="R":"RUNNING!!!",1:"Stopped.")
  1. W !!,?((IOM\2)-($L(PSXTXT)\2)-3),PSXTXT
  1. K PSXSTAT,PSXTXT
  1. Q
  1. EXIT K DIC,DIE,Y,DR,DA
  1. Q
  1. DRUGW ;
  1. F Z0=1:1 Q:$P(X,",",Z0,99)="" S Z1=$P(X,",",Z0) W:$D(^PS(54,Z1,0)) ?35,$P(^(0),"^"),! I '$D(^(0)) W ?35,"NO SUCH WARNING LABEL" K X Q
  1. Q
  1. DRG ;
  1. F X=0:0 S X=$O(^PSDRUG(X)) Q:'$G(X) I $D(^PSDRUG(X,5)) D
  1. .S XX=$P(^PSDRUG(X,5),"^"),^(5)=XX K XX
  1. Q
  1. UNMARK ;Entry point to unmark drug for CMOP dispense
  1. N PSX,Z,%
  1. S $P(^PSDRUG(PSXCK,3),"^",1)=0 K ^PSDRUG("AQ",PSXCK)
  1. S:'$D(^PSDRUG(PSXCK,4,0)) ^PSDRUG(PSXCK,4,0)="^50.0214DA^^"
  1. S (PSX,Z)=0 F S Z=$O(^PSDRUG(PSXCK,4,Z)) Q:'Z S PSX=Z
  1. S PSX=PSX+1 D NOW^%DTC S ^PSDRUG(PSXCK,4,PSX,0)=%_"^E^"_DUZ_"^CMOP Dispense^"_$S($G(^PSDRUG(PSXCK,3))=1:"YES",$G(^PSDRUG(PSXCK,3))=0:"NO",1:"")
  1. S $P(^PSDRUG(PSXCK,4,0),"^",3)=PSX,$P(^(0),"^",4)=$P(^(0),"^",4)+1
  1. K PSX,Z,%
  1. Q
  1. RALRT S XQAMSG=PSXFILE_" file is in use. Transmission not completed. Contact IRM." D GRP1^PSXNOTE,SETUP^XQALERT K PSXFILE,XQALERT,XQA,XQAMSG Q
  1. SETVER S DIC="9.4",X="OUTPATIENT PHARMACY",DIC(0)="MOZX" D ^DIC D:$G(Y)'>0 ALRT Q:$G(Y)'>0 S XDA=+$G(Y) K X,Y,DIC,DIC(0)
  1. S DA=XDA,DIQ="PSXUTL1",DIQ(0)="I",DIC="9.4",DR="13" D EN^DIQ1 S PSXV=+$G(PSXUTL1(9.4,XDA,13,"I")) D:$G(PSXV)'>0 ALRT K DA,XDA,DIQ,DIQ(0),DIC,X,Y,PSXUTL1 S PSXVER=$S($G(PSXV)>"6.0":1,1:"")
  1. Q
  1. ALRT S XQAMSG="Package file entry for Outpatient Pharamacy is corrupt" D GRP1^PSXNOTE,SETUP^XQALERT K PSXFILE,XQALERT,XQA,XQAMSG S PSXER=$G(PSXER)_"^"_12 D ER1^PSXERR K PSXER Q
  1. ;
  1. GETS(FILE,IENS,DR,FORM,TARG,ERR) ;
  1. S IENS=$$IENS(IENS)
  1. I $D(ERR) D GETS^DIQ(FILE,IENS,DR,FORM,TARG,ERR) I 1
  1. E D GETS^DIQ(FILE,IENS,DR,FORM,TARG)
  1. D TOP(TARG)
  1. Q
  1. IENS(IENS) ;Resolve IENS to numbers X,Y,Z to 89,34,345
  1. N I,X
  1. F I=1:1 S X=$P(IENS,",",I) Q:X="" D
  1. . I X'=+X F S X=@X I X=+X S $P(IENS,",",I)=X Q
  1. Q IENS
  1. ;
  1. TOP(TARGROOT) ; Move to the top the returned DIQ array
  1. ; Move array(file,iens,field)=value to array(field)=value
  1. ; also moves the ,field,"I") =value(internal) to (field)=value(internal)
  1. Q:'$D(@TARGROOT)
  1. N FILE,IENS,FLD
  1. S FILE=$O(@TARGROOT@(""))
  1. S IENS=$O(@TARGROOT@(FILE,""))
  1. S FLD=+$O(@TARGROOT@(FILE,IENS,""))
  1. M ^TMP($J,"TOP")=@TARGROOT@(FILE,IENS)
  1. K @TARGROOT
  1. M @TARGROOT=^TMP($J,"TOP")
  1. K ^TMP($J,"TOP")
  1. ; if form is of xx(FLD,"I") move value to xx(FLD)
  1. I $O(@TARGROOT@(FLD,""))="I" D
  1. . S FLD=0 F S FLD=$O(@TARGROOT@(FLD)) Q:FLD'>0 D
  1. .. S @TARGROOT@(FLD)=@TARGROOT@(FLD,"I") K @TARGROOT@(FLD,"I")
  1. Q
  1. ;
  1. PIECE(REC,DLM,XX) ; where XX = VAR_U_I ex: XX="PATNM^1"
  1. ; Set VAR = piece I of REC using delimiter DLM
  1. N Y,I S Y=$P(XX,U),I=$P(XX,U,2),@Y=$P(REC,DLM,I)
  1. Q
  1. SET(REC,DLM,ABCD) ; where XX = VAR_U_I ex: XX="PATNM^1"
  1. ; Set VAR into piece I of REC using delimiter DLM
  1. N Y,I S Y=$P(ABCD,U),I=$P(ABCD,U,2)
  1. I Y'=+Y,Y'="" S $P(REC,DLM,I)=$G(@Y) I 1
  1. E S $P(REC,DLM,I)=Y