source: FOIAVistA/tag/r/CMOP-PSX/PSXUTL.m@ 1607

Last change on this file since 1607 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 5.0 KB
Line 
1PSXUTL ;BIR/BAB,WPB,HTW-Utility Subroutines ;14 Feb 2002 2:27 PM
2 ;;2.0;CMOP;**3,38**;11 Apr 97
3 ;Reference to ^PS(54 supported by DBIA #2227
4 ;Reference to ^PSDRUG( supported by DBIA #1983
5 ;
6HEX ;converts decimal #<128 to a two byte hex #
7 ;requires PSXHEX = decimal # to be converted
8 ;returns PSXHEX = hex #, if error PSXHEX=""
9 N %,H,H1,H2 S %=PSXHEX
10 I (%<0)!(%>127)!(%'=+%) S PSXHEX="" Q ;error if # not between 0 - 127
11 I %<10 S PSXHEX=0_% Q ;if # < 10 result is trivial, pad with zero
12 S H=%\16 S:H>9 H=$E(" ABCDEF",H) S H1=H
13 S H=%#16 S:H>9 H=$E(" ABCDEF",H) S H2=H
14 S PSXHEX=H1_H2
15 Q
16FLUSH1 N X,X1,X2,N S N=0
17 ; the *READ is for the CMOP vendors CPU only
18 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
19 Q
20 ;check to see if a timer has expired
21 ;requires PSXTM = PSXTMx where x is A, B, D or E
22 ;returns PSXTMOUT=1 if timer has expired, otherwise PSXTMOUT=0
23CHKA S DELTA=PSXDLTA,PSXTM=PSXTMA G CHK
24CHKB S DELTA=PSXDLTB,PSXTM=PSXTMB G CHK
25CHKD S DELTA=PSXDLTD,PSXTM=PSXTMD G CHK
26CHKE S DELTA=PSXDLTE,PSXTM=PSXTME
27CHK N %
28 S %=$P($H,",",2) S:%<PSXTM %=%+86400
29 S PSXTMOUT=$S(%'>(PSXTM+DELTA):0,1:1)
30 K DELTA
31 Q
32LOG ;create a log entry in the CMOP INTERFACE file
33 ;requires the LOG() array with the text of the MESSAGE
34 N X,Y
35 H 1
36 D NOW^%DTC K %I,%H
37 K DIC,DD,DO
38 S X=%,DINUM=9999999-X,DIC="^PSX(553,"_1_",""X"",",DIC(0)="Z"
39 D FILE^DICN G:$P(Y,"^",3)'=1 LOG
40 L +^PSX(553,1,"S"):DTIME Q:'$T
41 S X="" F %=1:1 S X=$O(LOG(X)) Q:'X S ^PSX(553,1,"X",+Y,"X",%,0)=LOG(X)
42 S %=%-1,^PSX(553,1,"X",+Y,"X",0)="^^"_%_"^"_%_"^"_$P(+Y(0),".")
43 L -^PSX(553,1,"S")
44 K DD,DO,DUOUT,DTOUT,X,Y,DIC,DINUM,%,DLAYGO
45 Q
46TSOUT ;convert current date time to HL7 timestamp
47 ;returns PSXTS= YYYYMMDDHHMM
48 D NOW^%DTC
49 S %=$E($P(%,".",2),1,6)
50 S PSXTS=(1700+$E(X,1,3))_$E(X,4,7)_%_$E("0000",1,4-$L(%))
51 K %,%H,%I
52 Q
53TSIN ;convert an HL7 timestamp to fileman format
54 ;returns e.g. PSXFM=2910305.213
55 ;requires PSXTS as input with YYYYMMDDHHMM format
56 I $G(PSXTS)']""!($L(PSXTS)<7) S PSXFM=""
57 N X S X=$E(PSXTS,9,14) S PSXFM=$E(PSXTS,1,2)-17_$E(PSXTS,3,8)_$S(+X:+("."_X),1:"")
58 Q
59STATUS ;display CMOP status for entry action on RX menu
60 N PSXSTAT,PSXTXT
61 S PSXSTAT=$G(^PSX(553,1,"S"))
62 Q:$G(PSXSTAT)=""
63 S PSXTXT="CMOP Interface is "_$S(PSXSTAT="R":"RUNNING!!!",1:"Stopped.")
64 W !!,?((IOM\2)-($L(PSXTXT)\2)-3),PSXTXT
65 K PSXSTAT,PSXTXT
66 Q
67EXIT K DIC,DIE,Y,DR,DA
68 Q
69DRUGW ;
70 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
71 Q
72DRG ;
73 F X=0:0 S X=$O(^PSDRUG(X)) Q:'$G(X) I $D(^PSDRUG(X,5)) D
74 .S XX=$P(^PSDRUG(X,5),"^"),^(5)=XX K XX
75 Q
76UNMARK ;Entry point to unmark drug for CMOP dispense
77 N PSX,Z,%
78 S $P(^PSDRUG(PSXCK,3),"^",1)=0 K ^PSDRUG("AQ",PSXCK)
79 S:'$D(^PSDRUG(PSXCK,4,0)) ^PSDRUG(PSXCK,4,0)="^50.0214DA^^"
80 S (PSX,Z)=0 F S Z=$O(^PSDRUG(PSXCK,4,Z)) Q:'Z S PSX=Z
81 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:"")
82 S $P(^PSDRUG(PSXCK,4,0),"^",3)=PSX,$P(^(0),"^",4)=$P(^(0),"^",4)+1
83 K PSX,Z,%
84 Q
85RALRT S XQAMSG=PSXFILE_" file is in use. Transmission not completed. Contact IRM." D GRP1^PSXNOTE,SETUP^XQALERT K PSXFILE,XQALERT,XQA,XQAMSG Q
86SETVER 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)
87 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:"")
88 Q
89ALRT 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
90 ;
91GETS(FILE,IENS,DR,FORM,TARG,ERR) ;
92 S IENS=$$IENS(IENS)
93 I $D(ERR) D GETS^DIQ(FILE,IENS,DR,FORM,TARG,ERR) I 1
94 E D GETS^DIQ(FILE,IENS,DR,FORM,TARG)
95 D TOP(TARG)
96 Q
97IENS(IENS) ;Resolve IENS to numbers X,Y,Z to 89,34,345
98 N I,X
99 F I=1:1 S X=$P(IENS,",",I) Q:X="" D
100 . I X'=+X F S X=@X I X=+X S $P(IENS,",",I)=X Q
101 Q IENS
102 ;
103TOP(TARGROOT) ; Move to the top the returned DIQ array
104 ; Move array(file,iens,field)=value to array(field)=value
105 ; also moves the ,field,"I") =value(internal) to (field)=value(internal)
106 Q:'$D(@TARGROOT)
107 N FILE,IENS,FLD
108 S FILE=$O(@TARGROOT@(""))
109 S IENS=$O(@TARGROOT@(FILE,""))
110 S FLD=+$O(@TARGROOT@(FILE,IENS,""))
111 M ^TMP($J,"TOP")=@TARGROOT@(FILE,IENS)
112 K @TARGROOT
113 M @TARGROOT=^TMP($J,"TOP")
114 K ^TMP($J,"TOP")
115 ; if form is of xx(FLD,"I") move value to xx(FLD)
116 I $O(@TARGROOT@(FLD,""))="I" D
117 . S FLD=0 F S FLD=$O(@TARGROOT@(FLD)) Q:FLD'>0 D
118 .. S @TARGROOT@(FLD)=@TARGROOT@(FLD,"I") K @TARGROOT@(FLD,"I")
119 Q
120 ;
121PIECE(REC,DLM,XX) ; where XX = VAR_U_I ex: XX="PATNM^1"
122 ; Set VAR = piece I of REC using delimiter DLM
123 N Y,I S Y=$P(XX,U),I=$P(XX,U,2),@Y=$P(REC,DLM,I)
124 Q
125SET(REC,DLM,ABCD) ; where XX = VAR_U_I ex: XX="PATNM^1"
126 ; Set VAR into piece I of REC using delimiter DLM
127 N Y,I S Y=$P(ABCD,U),I=$P(ABCD,U,2)
128 I Y'=+Y,Y'="" S $P(REC,DLM,I)=$G(@Y) I 1
129 E S $P(REC,DLM,I)=Y
Note: See TracBrowser for help on using the repository browser.