source: FOIAVistA/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJHL7.m@ 1274

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

initial load of FOIAVistA 6/30/08 version

File size: 7.9 KB
Line 
1PSJHL7 ;BIR/LDT-ACTIONS ON HL7 MESSAGES FROM OE/RR (CONT) ;29 AUG 96 / 11:18 AM
2 ;;5.0; INPATIENT MEDICATIONS ;**42,47,50,70,82,110,127,133**;16 DEC 97
3 ;
4 ; Reference to ^PS(50.7 is supported by DBIA# 2180.
5 ; Reference to ^PS(51.1 is supported by DBIA# 2177.
6 ; Reference to ^PS(51.2 is supported by DBIA# 2178.
7 ; Reference to ^PS(52.6 is supported by DBIA# 1231.
8 ; Reference to ^PS(52.7 is supported by DBIA# 2173.
9 ; Reference to ^PS(55 is supported by DBIA# 2191.
10 ; Reference to ^SC( is supported by DBIA# 10040.
11 ; Reference to ^TMP("PSB" is supported by DBIA# 3564.
12 ;
13RENEW ;Renew orders from OE/RR
14 N PSJSYSW0,PSJSYSW,WRDPTR,PSJOSTOP,Q1,Q2
15 S PSJSYSW0="",PSJSYSW=0 I $G(LOC) S WRDPTR=$G(^SC(+LOC,42)) S:WRDPTR]"" PSJSYSW=+$O(^PS(59.6,"B",WRDPTR,0)) I PSJSYSW S PSJSYSW0=$G(^PS(59.6,PSJSYSW,0))
16 I PREON["V" D IVSET G DONE
17 N ND,ND1,ND2,PSGSI,PSGMR,PSGSM,PSGHSM,PSGST,OIDRG,PSGDO,PSGSCH,PSGSOY,PSGOXT,PSGNEDFD,DRUGS,WAT
18 S ND=$G(^PS(55,PSJHLDFN,5,+PREON,0)),ND1=$G(^(.2)),ND2=$G(^(2)),PSGSI=$G(^(6)),PSGWLL=$S($P(PSJSYSW0,"^",4):+$G(^PS(55,PSJHLDFN,5.1)),1:0)
19 I +PSITEM>0,PSITEM'=+$P(ND1,"^") S $P(ND1,"^")=PSITEM
20 S PSGMR=$P(ND,"^",3),PSGSM=$P(ND,"^",5),PSGHSM=$P(ND,"^",6),PSGST=$P(ND,"^",7),OIDRG=$P(ND1,"^"),PSGDO=$P(ND1,"^",2),DOSE=$P(ND1,"^",5),UNIT=$P(ND1,"^",6),PSGSCH=$P(ND2,"^")
21 S PSGSOY=$P(ND2,"^",5),PSGOXT=$P(ND2,"^",6),PSGNEDFD=$P($$GTNEDFD^PSGOE7("UI",OIDRG),"^")
22 S:$P(LOC,"^")'=$P(ND2,"^",10) PSGSOY=$$ENRNAT^PSJHL7($P(ND2,"^",10),+LOC,PSGSCH,PSGSOY)
23 S X=$O(^PS(55,PSJHLDFN,5,+PREON,1,0)) I X S (Q,Q1)=0 F S Q=$O(^PS(55,PSJHLDFN,5,+PREON,1,Q)) Q:'Q S ND=$G(^(Q,0)) I ND,$S('$P(ND,"^",3):1,1:$P(ND,"^",3)>DT) S Q1=Q1+1,DRUGS(Q1)=$P(ND,"^",1,3)
24 S (PSGNESD,PSGNEFD)="" D ENWALL^PSGNE3(PSGNESD,PSGNEFD,PSJHLDFN)
25 I PSGOXT="D",'PSGSOY S PSGSOY=+$E(PSGNESD_"00011",9,12)
26 S ND=NEWORDER_U_PROVIDER_U_PSGMR_U_"U"_U_PSGSM_U_PSGHSM_U_PSGST_"^^P^^^^^"_LOGIN_U_PSJHLDFN_U_LOGIN S:PSGNEDFD $P(ND,U,$P(PSGNEDFD,U)["L"+10)=+PSGNEDFD
27 S $P(ND,U,21)=$P(ORDER,U),$P(ND,U,24,25)=ROC_U_PREON
28 F X="PSGNESD","PSGNEFD" S:@X]"" @X=+@X
29 S ND2=PSGSCH_U_PSGNESD_"^^"_PSGNEFD_U_PSGSOY_U_PSGOXT
30 S F="^PS(53.1,"_NEWORDER_",",@(F_"0)")=ND,^(.2)=OIDRG_U_PSGDO_U_ORDCON_U_PRIORITY_U_DOSE_U_UNIT_U_U_$G(PRNTON),^(2)=ND2 S:$G(PSGSI)]"" ^(6)=PSGSI
31 I $D(DRUGS) D
32 .I $D(@(F_"1,0)")) K @(F_"1)")
33 .; Naked reference below refers to full reference to ^PS(53.1,+NEWORDER in variable F created using indirection.
34 .I '$D(@(F_"1,0)")) S ^(0)="^53.11P^0^0"
35 .S JJ=0 F S JJ=$O(DRUGS(JJ)) Q:'JJ I $S('$P(DRUGS(JJ),U,3):1,1:$P(DRUGS(JJ),U,3)>DT) S $P(@(F_"1,0)"),"^",3,4)=JJ_"^"_JJ,@(F_"1,"_JJ_",0)")=$P(DRUGS(JJ),U,1,2),@(F_"1,""B"","_+DRUGS(JJ)_","_JJ_")")=""
36 S PSJOSTOP=$G(@("^PS(55,"_PSJHLDFN_",5,"_+$G(PREON)_",2)")),PSJOSTOP=$P(PSJOSTOP,"^",4)
37 D REN531(NEWORDER,$P(ND,"^",14),$S($G(PREON)["U":$P(ND,"^",2),1:$P(ND,"^",6)),PSJOSTOP,PSJHLDFN)
38 ;
39DONE ;
40 N DA,DR,DIE,PSIVACT,PSIVALT,ON55,PSIVREA
41 S DIE=$S(PREON["V":"^PS(55,"_PSJHLDFN_",""IV"",",1:"^PS(55,"_PSJHLDFN_",5,"),DA=+PREON,DA(1)=PSJHLDFN,DR=$S(PREON["V":"100////R;123////R;114////"_PSJORDER,1:"28////R;107////R;105////"_PSJORDER)
42 I PREON["A"!(PREON["U") S PSGAL("C")=18000 D ^PSGAL5
43 I PREON["V" S PSIVACT=1,PSIVALT=2,ON55=PREON,PSIVREA="R"
44 D ^DIE
45 I PREON["V" N DFN S DFN=PSJHLDFN D LOG^PSIVORAL
46 S PSJHLMTN="ORM" D EN1^PSJHL2(PSJHLDFN,"SC",PREON) S PSJHLMTN="ORR",PSOC="NW"
47 Q
48IVSET ;
49 N DRG,DRGN,P
50 S P("RES")="R",P("REN")="",Y=$G(^PS(55,PSJHLDFN,"IV",+PREON,0)) F X=1:1:23 S P(X)=$P(Y,U,X)
51 S P("PON")=PREON,P(21)=$P(ORDER,U),P(6)=PROVIDER_U_$P($G(^VA(200,+PROVIDER,0)),U),(DRG,DRGN)="",P("REM")=$G(^PS(55,PSJHLDFN,"IV",+PREON,1))
52 S Y=$G(^PS(55,PSJHLDFN,"IV",+PREON,2)),P("LOG")=LOGIN
53 S P("CLRK")=CLERK_U_$P($G(^VA(200,+CLERK,0)),U),P("RES")=ROC,P("FRES")=$P(Y,U,9),P("SYRS")=$P(Y,U,4),P("OPI")=$G(^PS(55,PSJHLDFN,"IV",+PREON,3))
54 S ND=$G(^PS(55,PSJHLDFN,"IV",+PREON,.2)),P("PD")=$S($P(ND,U):$P(ND,U)_U_$P($G(^PS(50.7,+ND,0)),U),1:""),P("DO")=$P(ND,U,2)
55 S P("MR")=$P(ND,U,3),ND=$G(^PS(51.2,+P("MR"),0)),P("MR")=P("MR")_U_$S($P(ND,U,3)]"":$P(ND,U,3),1:$P(ND,U))
56 D GTDRG
57 S P("OT")=$S(P(4)="A":"F",P(4)="H":"I",1:"I")
58 I P("OT")="F" F DRGT="AD","SOL" F DRGI=0:0 S DRGI=$O(DRG(DRGT,DRGI)) Q:'DRGI I '$P(DRG(DRGT,DRGI),U,5) S P("OT")="I"
59PUT531 ; Move data in local variables to 53.1
60 N IVLIM,IVLIMIT S IVLIM=$$GETDUR^PSJLIVMD(PSJHLDFN,+PREON,$E(PREON,$L(PREON)),1) I IVLIM]"",$G(IVLIMIT) S $P(^PS(53.1,+NEWORDER,2.5),U,4)=IVLIM
61 S ND(0)=+NEWORDER_U_+P(6)_U_$S(+P("MR"):+P("MR"),1:"")_U_P("OT")_U_U_U_"C",$P(ND(0),U,9)="P"
62 S $P(ND(0),U,14,16)=P("LOG")_U_PSJHLDFN_U_P("LOG"),$P(ND(0),U,21)=P(21),$P(ND(0),U,24,26)=$G(P("RES"))_U_P("PON")
63 S ND(2)=P(9)_U_U_U_U_P(11)_U_P(15),$P(ND(4),U,7,9)=+P("CLRK")_U_U_P("REN")
64 S ND(8)=P(4)_U_P(23)_U_P("SYRS")_U_P(5)_U_P(8)_"^^"_P(7),ND(9)=$S($L(P("REM")_P("OPI")):P("REM")_U_P("OPI"),1:"")
65 F X=0,2,4,8,9 S ^PS(53.1,+NEWORDER,X)=ND(X)
66 S:+P("PD") ^PS(53.1,+NEWORDER,.2)=+P("PD")_U_P("DO")
67 S $P(^PS(53.1,+NEWORDER,.2),"^",3,4)=ORDCON_U_PRIORITY
68 ;I $G(PRNTON) I $$UP^XLFSTR($G(PSGSCH))="NOW" S PRNTON=""
69 I $G(PRNTON) S $P(^PS(53.1,+NEWORDER,.2),"^",8)=PRNTON
70 F DRGT="AD","SOL" D:$D(DRG(DRGT)) PTD531
71 S PSJOSTOP=$G(@("^PS(55,"_PSJHLDFN_",""IV"","_+PREON_",0)")),PSJOSTOP=$P(PSJOSTOP,"^",3) D
72 .N IVND S IVND=$G(^PS(53.1,+NEWORDER,0)) D REN531(NEWORDER,$P(IVND,"^",14),$P(ND,"^",2),PSJOSTOP,PSJHLDFN)
73 Q
74PTD531 ; Move drug data from local array into 53.1
75 K ^PS(53.1,+NEWORDER,DRGT) S ^PS(53.1,+NEWORDER,DRGT,0)=$S(DRGT="AD":"^53.157PA^0^0",1:"^53.158PA^0^0")
76 F X=0:0 S X=$O(DRG(DRGT,X)) Q:'X D
77 .S X1=$P(DRG(DRGT,X),U),Y=^PS(53.1,+NEWORDER,DRGT,0),$P(Y,U,3)=$P(Y,U,3)+1,DRG=$P(Y,U,3),$P(Y,U,4)=$P(Y,U,4)+1
78 .S ^PS(53.1,+NEWORDER,DRGT,0)=Y,Y=+X1_U_$P(DRG(DRGT,X),U,3) S:DRGT="AD" $P(Y,U,3)=$P(DRG(DRGT,X),U,4) S ^PS(53.1,+NEWORDER,DRGT,+DRG,0)=Y,^PS(53.1,+NEWORDER,DRGT,"B",+X1,+DRG)=""
79 I $G(P("RES"))="R",($G(ND(0))]"") D REN531(+NEWORDER,$P(ND(0),"^",14),$P(ND(0),"^",2),$G(P(3)),$G(DFN))
80 Q
81 ;
82ENRNAT(OWD,NWD,SC,OAT) ;Determine admin times for renewal orders.
83 ;OWD=ORIGINAL W,NWD=NEW WD LOCATION, SC=SCHEDULE, OAT=ORDER ADMIN TIMES
84 N OWAT,SCP,X,Y,OOAT
85 S OOAT=OAT,SCP=+$O(^PS(51.1,"APPSJ",+SC,0)),WAT=$P($G(^PS(51.1,SCP,1,+$G(OWD),0)),U,2)
86 F X="WAT","OAT" F Y=1:1 Q:$L(@X)>240!($P(@X,"-",Y)="") S $P(@X,"-",Y)=$P(@X,"-",Y)_$E("0000",1,4-$L($P(@X,"-",Y)))
87 I OAT'=WAT Q OOAT
88 S X=$P($G(^PS(51.1,+SCP,1,NWD,0)),U,2) I X Q X
89 Q OOAT
90 ;
91GTDRG ; Get drug info and place in DRG(.
92 F DRGT="AD","SOL" S FIL=$S(DRGT="AD":52.6,1:52.7) F Y=0:0 S Y=$O(^PS(55,PSJHLDFN,"IV",+PREON,DRGT,Y)) Q:'Y D
93 .;Naked reference ^(Y,0) below refers to full global reference ^PS(55,PSJHLDFN,"IV",+PREON,DRGT,Y)) above at GTDRG+1
94 .S DRG=$G(^(Y,0)),ND=$G(^PS(FIL,+DRG,0)),(DRGI,DRG(DRGT,0))=$G(DRG(DRGT,0))+1,DRG(DRGT,+DRGI)=+DRG_U_$P(ND,U)_U_$P(DRG,U,2)_U_$P(DRG,U,3)_U_$P(ND,U,13)_U_$P(ND,U,11)
95 Q
96 ;
97REN531(PSGORD,PSGDT,PSGOEPR,PSGOFD,PSGP) ;
98 Q:'PSGORD!'PSGDT!'PSGOEPR!'PSGOFD!'PSGP
99 N DUP,PSGOLDPR I $G(PREON) D Q:$G(DUP)
100 .S:$D(^PS(53.1,+PSGORD,14,"B",+PSGDT)) DUP=1 Q
101 S:$G(PREON)["U" PSGOLDPR=$P($G(^PS(55,PSGP,5,+PREON,0)),"^",2)
102 S:$G(PREON)["V" PSGOLDPR=$P($G(^PS(55,PSGP,"IV",+PREON,0)),"^",6)
103 K DR,DA,DIC,DIE,DD,DO S DIC="^PS(53.1,"_+PSGORD_",14,",DIC(0)="L",DIC("P")="53.1114DA",ND14=$G(@(DIC_"0)")),DINUM=$P(ND14,"^",3)+1,DA(2)=PSGP,DA(1)=+PSGORD D
104 . S DIC("DR")=".01////"_$G(PSGDT)_";1////"_$G(DUZ)_";2////"_$S($G(PSGOLDPR):$G(PSGOLDPR),1:$G(PSGOEPR))_";3////"_$G(PSGOFD),X=$G(PSGDT) D FILE^DICN
105 K DO,DINUM
106 Q
107 ;
108CHK(X,Y,Z) ;Check for required fields
109 ; Input: X="^^"_MED ROUTE_"^^^^"_SCH TYPE
110 ; Y=ORDERABLE ITEM_"^"_DOSAGE ORDERED
111 ; Z=SCHEDULE_"^"_START DATE/TIME_"^^"_STOP DATE/TIME
112 S:'$D(^PS(50.7,+Y,0)) CHK=1
113 I ND="" S CHK=CHK_23
114 E S CHK=CHK_$S($P(X,"^",3):"",1:2)_$S($P(X,"^",7)]"":"",1:3)
115 K PSGDFLG,PSGPFLG S PSGDI=0
116 S:'$$DDOK^PSJHL10("^TMP(""PSB"","_$J_",700,",+Y) CHK=CHK_7
117 ;
118CHKM ;
119 Q:'CHK
120 N MSG2
121 S MSG="THE FOLLOWING "_$S($L(CHK)>1:"ARE",1:"IS")_" EITHER INVALID OR MISSING FROM THIS ORDER:" F X=1:1:7 S:CHK[X MSG2=$P("ORDERABLE ITEM^MED ROUTE^SCHEDULE TYPE^SCHEDULE^START DATE/TIME^STOP DATE/TIME^DISPENSE DRUG","^",X)
122 S PSREASON=MSG_MSG2
123 Q
Note: See TracBrowser for help on using the repository browser.