251 lines
7.7 KiB
Mathematica
251 lines
7.7 KiB
Mathematica
PSOVDF3 ;BIR/RTR-OUTPATIENT PHARMACY VDEF MESSAGE CONTINUED ;06/16/05
|
|
;;7.0;OUTPATIENT PHARMACY;**205,235,261**;DEC 1997;Build 9
|
|
;External reference to PS(50.7 supported by DBIA 2223
|
|
;External refernce to PS(50.607 supported by DBIA 2221
|
|
;
|
|
DOSE(GLOBAL) ;Add Dosage information to RXE 1
|
|
N RES S RES=""
|
|
N PSODD1,PSODD2,PSODD3,PSODD5,PSODDL,PSODDN,PSORES1,PSODDUNT,PSOD1FLG
|
|
F PSODDL=0:0 S PSODDL=$O(GLOBAL(PSODDL)) Q:'PSODDL D
|
|
.S PSODDN=$G(GLOBAL(PSODDL,0)) Q:PSODDN=""
|
|
.S PSODD1=$P(PSODDN,"^"),PSODD2=$P(PSODDN,"^",2),PSODD3=$P(PSODDN,"^",3),PSODD5=$P(PSODDN,"^",5),PSODDUNT=""
|
|
.I PSODD1="",PSODD2="",PSODD5="" Q
|
|
.I PSODD5'="",($E(PSODD5,$L(PSODD5))'?1A) S PSODD5=PSODD5_"D"
|
|
.I PSODD5'="" S PSODD5=$$REPL^PSOVDF1(PSODD5)
|
|
.S PSOD1FLG=0
|
|
.I PSODD2'="",PSODD3'="",$P($G(^PS(50.607,PSODD3,0)),"^")'="" S PSOD1FLG=1,PSODDUNT=$P($G(^(0)),"^"),PSODDUNT=$$REPL^PSOVDF1(PSODDUNT) S:$G(PSODD1)'="" PSODD1=$$REPL^PSOVDF1(PSODD1),PSODD1=PSODD1_PSODDUNT
|
|
.I 'PSOD1FLG,$G(PSODD1)'="" S PSODD1=$$REPL^PSOVDF1(PSODD1)
|
|
.S PSORES1=""
|
|
.I PSODD1'=""!(PSODD2'="") D
|
|
..I PSODD2'="" S PSODD2=$$REPL^PSOVDF1(PSODD2) S PSORES1=PSODD2 S:PSODD1'="" PSORES1=PSORES1_SEPS_PSODD1 Q
|
|
..S PSORES1=SEPS_PSODD1
|
|
.I PSODD5'="" D
|
|
..I PSORES1="" S PSORES1=SEPC_SEPC_PSODD5 Q
|
|
..S PSORES1=PSORES1_SEPC_SEPC_PSODD5
|
|
.Q:PSORES1=""
|
|
.I $G(RES)'="" S RES=RES_SEPR_PSORES1 Q
|
|
.S RES=PSORES1
|
|
K TEMP
|
|
Q RES
|
|
;
|
|
FINISH ;Finish rest of RXE 1 segment
|
|
N PSOVAL1 S PSOVAL1=$P(VAL,SEPR)
|
|
S WR=""
|
|
S WR=$$GET^PSOVDF2(.GL,2,2)
|
|
I $G(WR)'="" S WR=$$HLDATE^HLFNC(WR,"TS") I WR>0 S WR=$$REPL^PSOVDF1(WR),$P(PSOVAL1,SEPC,4)=WR,$P(PSOVAL1,SEPC,7)="FILL"
|
|
; (1~5-26.1)
|
|
S WR=$$GET^PSOVDF2(.GL,3,5)
|
|
I $G(WR)'="" D
|
|
.S WR=$$HLDATE^HLFNC(WR,"TS") I WR>0 S WR=$$REPL^PSOVDF1(WR),$P(PSOVAL1,SEPC,5)=WR,$P(PSOVAL1,SEPC,7)=$P(PSOVAL1,SEPC,7)_"/CANCEL"
|
|
E S WR=$$GET^PSOVDF2(.GL,2,6) I $G(WR)'="" D
|
|
. S WR=$$HLDATE^HLFNC(WR,"TS") I WR>0 S WR=$$REPL^PSOVDF1(WR),$P(PSOVAL1,SEPC,5)=WR,$P(PSOVAL1,SEPC,7)=$P(PSOVAL1,SEPC,7)_"/EXPIRATION"
|
|
S $P(VAL,SEPR)=PSOVAL1
|
|
S WR=""
|
|
Q
|
|
;
|
|
REM ;Remarks for Original Fill
|
|
S MSG="",CTR=0
|
|
S VAL=$$GET^PSOVDF2(.GL,3,7)
|
|
I $G(VAL)="" Q
|
|
S VAL=$$REPL^PSOVDF1(VAL)
|
|
D PUT(3)
|
|
S CTR=CTR+1,VAL=CTR D PUT(1)
|
|
S VAL="RE"_SEPC_"REMARKS"_SEPC_SRC_"_12" D PUT(4)
|
|
S MSG="NTE"_SEPF_MSG D OUT^PSOVDF2
|
|
Q
|
|
;
|
|
DEL ;Deletion comments
|
|
S MSG=""
|
|
S VAL=$$GET^PSOVDF2(.GL,"D",1)
|
|
I $G(VAL)="" Q
|
|
S VAL=$$REPL^PSOVDF1(VAL)
|
|
D PUT(3)
|
|
S CTR=CTR+1,VAL=CTR D PUT(1)
|
|
S VAL="DE"_SEPC_"DELETION COMMENTS"_SEPC_SRC_"_108" D PUT(4)
|
|
S MSG="NTE"_SEPF_MSG D OUT^PSOVDF2
|
|
Q
|
|
;
|
|
CLOZ ; Clozapine Dosage
|
|
S VAL=$$REPL^PSOVDF1(VAL)
|
|
D PUT(5)
|
|
S CTR=CTR+1,VAL=CTR D PUT(1)
|
|
S VAL="NM" D PUT(2)
|
|
S VAL="CLOZAPINE DOSAGE" D PUT(3)
|
|
S VAL="MG/DAY" D PUT(6)
|
|
S VAL="F" D PUT(11)
|
|
S MSG="OBX"_SEPF_MSG D OUT^PSOVDF2
|
|
Q
|
|
;
|
|
WBC ; WBC results
|
|
S VAL=$$REPL^PSOVDF1(VAL)
|
|
D PUT(5)
|
|
S CTR=CTR+1,VAL=CTR D PUT(1)
|
|
S VAL="NM" D PUT(2)
|
|
S VAL="WBC RESULTS" D PUT(3)
|
|
S VAL="F" D PUT(11)
|
|
; (14-303)
|
|
S VAL=$$GET^PSOVDF2(.GL,"SAND",3)
|
|
I $G(VAL)'="" S VAL=$$HLDATE^HLFNC(VAL,"TS") I VAL>0 S VAL=$$REPL^PSOVDF1(VAL) D PUT(14)
|
|
S MSG="OBX"_SEPF_MSG D OUT^PSOVDF2
|
|
Q
|
|
PRC ;Provider Comments, do not piece out data, can contain up-arrow
|
|
S MSG=""
|
|
I '$D(GL("PRC")) Q
|
|
S VAL="" K TEMP M TEMP=GL("PRC") S VAL=$$SSETZ(.TEMP,1)
|
|
I $G(VAL)="" Q
|
|
D PUT(3)
|
|
S CTR=CTR+1,VAL=CTR D PUT(1)
|
|
S VAL="PR"_SEPC_"PROVIDER COMMENTS"_SEPC_HLINST_"_52.039_.01" D PUT(4)
|
|
S MSG="NTE"_SEPF_MSG D OUT^PSOVDF2
|
|
Q
|
|
SSETZ(GLOBAL,P) ;Format Provider Comments
|
|
N RES,PSOVPCOM,PSOVDFD1,X
|
|
S (RES,X)="",PSOVDFD1=0
|
|
SSET10Z S PSOVDFD1=$O(GLOBAL(PSOVDFD1)) G SSETQZ:'PSOVDFD1
|
|
S PSOVPCOM=GLOBAL(PSOVDFD1,0) I PSOVPCOM="" G SSET10Z
|
|
I $G(RES)'="" S RES=RES_" "_PSOVPCOM
|
|
E S RES=PSOVPCOM
|
|
G SSET10Z
|
|
SSETQZ ;
|
|
I $G(RES)'="" S RES=$$REPL^PSOVDF1(RES)
|
|
Q RES
|
|
;
|
|
Q
|
|
;
|
|
PUT(P) ; Put in MSG
|
|
I $G(VAL)="" Q
|
|
S $P(MSG,SEPF,P)=VAL
|
|
Q
|
|
;
|
|
SSET(GL,L) ;Instruction field
|
|
N RES,X,Y
|
|
S RES="",Y=0
|
|
Q:$G(L)="" RES
|
|
F S Y=$O(GL(Y)) Q:'Y D
|
|
. S X=GL(Y,0),X=$$REPL^PSOVDF1(X) I X'="" D
|
|
. . S X=SEPC_X
|
|
. . I $G(RES)'="" S RES=RES_SEPR_X_SEPC_L
|
|
. . E S RES=X_SEPC_L
|
|
. . S CTR=CTR+1
|
|
Q RES
|
|
;
|
|
SSETX(GLOBAL,L) ;Format Sig, don't piece out, can possibly contain up-arrow from Provider Comments
|
|
Q:L=""
|
|
N RES,PSOVSIG,PSOVDFD1,X
|
|
S (RES,X)="",PSOVDFD1=0
|
|
SSET10X S PSOVDFD1=$O(GLOBAL(PSOVDFD1)) G SSETQX:'PSOVDFD1
|
|
S PSOVSIG=GLOBAL(PSOVDFD1,0) I PSOVSIG'="" D
|
|
.S PSOVSIG=$$REPL^PSOVDF1(PSOVSIG)
|
|
.I $G(RES)'="" S RES=RES_PSOVSIG
|
|
.E S RES=$S(L[115:SEPC,1:"")_PSOVSIG
|
|
G SSET10X
|
|
SSETQX I $G(RES)="" Q RES
|
|
I L[115 S RES=RES_SEPC_L
|
|
E S RES=RES_SEPC_SEPC_L
|
|
Q RES
|
|
;
|
|
Q
|
|
ORC13 ;
|
|
S WR="",$P(WR,SEPC,2)=VAL
|
|
S VAL=$P($G(^SC(VAL,0)),U) I $G(VAL)'="" S VAL=$$REPL^PSOVDF1(VAL),$P(WR,SEPC)=VAL
|
|
S VAL=WR
|
|
Q
|
|
;
|
|
RXE1OF31 ;
|
|
D RXE31A
|
|
S:WR'="" VAL=WR_SEPR_VAL
|
|
Q
|
|
;
|
|
RXE31 ;
|
|
S VAL=$P($G(^PSDRUG(PSOVDRUG,0)),"^"),VAL=$$REPL^PSOVDF1(VAL)
|
|
S VAL=PSOVDRUG_SEPC_VAL_SEPC_HLINST_"_50_.01"
|
|
Q
|
|
;
|
|
RXE31A ;
|
|
D RXE31
|
|
N CMOP S CMOP=$G(^PSDRUG(PSOVDRUG,"ND"))
|
|
I $P(CMOP,"^",10)'="" S CMOP=$$REPL^PSOVDF1($P(CMOP,"^",10)),VAL=VAL_SEPR_CMOP_SEPC_SEPC_HLINST_"_50_27"
|
|
Q
|
|
;
|
|
RXE6 ;
|
|
N DOSF,DOS,VDOS
|
|
S DOSF="",VDOS=$$GET^PSOVDF2(.GL,"OR1",1)
|
|
Q:VDOS=""
|
|
I $G(VDOS) S DOS=$P($G(^PS(50.7,VDOS,0)),"^",2) D:$G(DOS)
|
|
. S DOSF=$$REPL^PSOVDF1($P($G(^PS(50.606,DOS,0)),"^")) D:DOSF'=""
|
|
. . S VAL=DOS_SEPC_DOSF_SEPC_HLINST_"_50.7_.02"
|
|
. . S VDOS=$$GETVUID^XTID(50.7,.02,DOS) D:$P(VDOS,"^")'=0
|
|
. . . S VDOS=$P(VDOS,"^"),VDOS=$$REPL^PSOVDF1(VDOS) S VAL=VAL_SEPC_VDOS_SEPC_DOSF_SEPC_"99VA_50.7_.02"
|
|
Q
|
|
;
|
|
FT1A7 ;
|
|
S TP=$$GET^PSOVDF2(.GL,"OR1",1)
|
|
S:$G(TP) VAL=$$REPL^PSOVDF1($P($G(^PS(50.7,TP,0)),"^"))
|
|
I VAL'="" S VAL=TP_SEPC_VAL_SEPC_SRC_"_39.2",VFT7=VAL
|
|
Q
|
|
;
|
|
FT1S2 ; ORIGINAL SEQ# 2
|
|
S VAL=$$GET1^DIQ(52,PSOVDFD0_",",105,"I") Q:VAL=""
|
|
S WR=$$GET1^DIQ(52,PSOVDFD0_",",105) Q:WR=""
|
|
S MSG="",WR=$$REPL^PSOVDF1(WR)
|
|
S VAL=VAL_SEPC_WR_SEPC_SRC_"_105" D PUT(7)
|
|
S VAL=$G(CTR)+1 D PUT(1)
|
|
S VAL=$$GET^PSOVDF2(.GL,2,2)
|
|
I $G(VAL)'="" S VAL=$$HLDATE^HLFNC(VAL,"TS") I VAL>0 S VAL=$$REPL^PSOVDF1(VAL) D PUT(4)
|
|
S VAL="CO" D PUT(6)
|
|
S MSG="FT1"_SEPF_MSG D OUT^PSOVDF2
|
|
Q
|
|
;
|
|
FT1R ; REFILL & PARTIAL
|
|
S VAL=$P(TP,U,11) Q:VAL=""
|
|
S MSG="",VAL=$$REPL^PSOVDF1(VAL) D PUT(12)
|
|
S VAL=PSOVDFD1 D PUT(1)
|
|
S VAL=$P(TP,U,1) I VAL'="" S VAL=$$HLDATE^HLFNC(VAL,"TS") I VAL>0 S VAL=$$REPL^PSOVDF1(VAL) D PUT(4)
|
|
S VAL="CG" D PUT(6)
|
|
I $G(VFT7) S VAL=VFT7 D PUT(7)
|
|
S MSG="FT1"_SEPF_MSG D OUT^PSOVDF2
|
|
Q
|
|
;
|
|
NSET(GLOBAL) ;Verb-8, Noun-3, Schedule-7, Conjuntion-5
|
|
N I,J,K,L,M,N,O,P,X,Y,Z
|
|
S (Z,X)="",Y=0,M=52.0113
|
|
NSET1 ;
|
|
F S Y=$O(GLOBAL(Y)) Q:'Y D
|
|
. S X=$G(GLOBAL(Y,0)) Q:X=""
|
|
. F I=9,4,8,6 S N=I-1,O=M_"_"_N,L=HLINST_"_"_O D
|
|
. . S J=$P($G(X),U,I),J=$$REPL^PSOVDF1(J) I J'="" D
|
|
. . . S P=0 I I=6 S J=$$GET1^DIQ(M,Y_","_PSOVDFD0,N) D
|
|
. . . . S K=$$GETVUID^XTID(M,N) I $P(K,"^")'=0 S K=$P(K,"^"),K=$$REPL^PSOVDF1(K),J=K_SEPC_J_SEPC_"99VA_",P=1
|
|
. . . S J=$S(P:"",1:SEPC)_J
|
|
. . . I Z'="" S Z=Z_SEPR_J_$S(P:O,1:SEPC_L)
|
|
. . . E S Z=J_SEPC_$S(P:O,1:L)
|
|
. . . S CTR=CTR+1
|
|
Q Z
|
|
;
|
|
ORCCS ; ORC 25,4-6 - Checking the CMOP EVENT sub-file (#52.01)
|
|
N X,Y,RF,VU,I,ST S I=0
|
|
F S I=$O(GL(4,I)) Q:'I S X=GL(4,I,0) I X'="" S RF=$P(X,"^",3),Y=$P(X,"^",4) D
|
|
. I Y'="" S ST=$$GET1^DIQ(52.01,I_","_PSOVDFD0,3) I ST'="" S VU=$$GETVUID^XTID(52.01,3) D
|
|
. . I $P(VU,"^")'=0 S VU=$P(VU,"^"),VU=$$REPL^PSOVDF1(VU)
|
|
. . E S VU=""
|
|
. . S ST=$$REPL^PSOVDF1(ST)
|
|
. . S VCMP(RF)=$S(VU'="":VU,1:Y)_SEPC_ST_SEPC_$S(VU'="":"99VA",1:HLINST)_"_52_400"
|
|
Q
|
|
;
|
|
ORC25 ;
|
|
N PSOVALE S PSOVALE=$G(PSOVAR(52,PSOVEN,100,"E")),PSOVALE=$$REPL^PSOVDF1(PSOVALE)
|
|
S PSOVLV=$$GETVUID^XTID(52,100,VAL)
|
|
I $P($G(PSOVLV),"^")'=0 S PSOVLV=$P(PSOVLV,"^"),PSOVLV=$$REPL^PSOVDF1(PSOVLV) D Q
|
|
. S VAL=$G(PSOVLV)_SEPC_$G(PSOVALE)_SEPC_"99VA_52_100"
|
|
I $G(VAL)'="" S VAL=$$REPL^PSOVDF1(VAL),VAL=VAL_SEPC_$G(PSOVALE)_SEPC_SRC_"_100"
|
|
Q
|
|
;
|
|
PREM ;
|
|
S VAL="RE"_SEPC_"REMARKS"_SEPC_HLINST_"_52.2_.03"
|
|
Q
|
|
;
|
|
RREM ;
|
|
S VAL="RE"_SEPC_"REMARKS"_SEPC_HLINST_"_52.1_3"
|
|
Q
|
|
;
|