source: FOIAVistA/tag/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJHL7.m@ 636

PSJHL7 ;BIR/LDT-ACTIONS ON HL7 MESSAGES FROM OE/RR (CONT) ;29 AUG 96 / 11:18 AM
 ;;5.0; INPATIENT MEDICATIONS ;**42,47,50,70,82,110,127,133**;16 DEC 97
 ;
 ; Reference to ^PS(50.7 is supported by DBIA# 2180.
 ; Reference to ^PS(51.1 is supported by DBIA# 2177.
 ; Reference to ^PS(51.2 is supported by DBIA# 2178.
 ; Reference to ^PS(52.6 is supported by DBIA# 1231.
 ; Reference to ^PS(52.7 is supported by DBIA# 2173.
 ; Reference to ^PS(55 is supported by DBIA# 2191.
 ; Reference to ^SC( is supported by DBIA# 10040.
 ; Reference to ^TMP("PSB" is supported by DBIA# 3564.
 ; 
RENEW ;Renew orders from OE/RR
 N PSJSYSW0,PSJSYSW,WRDPTR,PSJOSTOP,Q1,Q2
 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))
 I PREON["V" D IVSET G DONE
 N ND,ND1,ND2,PSGSI,PSGMR,PSGSM,PSGHSM,PSGST,OIDRG,PSGDO,PSGSCH,PSGSOY,PSGOXT,PSGNEDFD,DRUGS,WAT
 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)
 I +PSITEM>0,PSITEM'=+$P(ND1,"^") S $P(ND1,"^")=PSITEM
 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,"^")
 S PSGSOY=$P(ND2,"^",5),PSGOXT=$P(ND2,"^",6),PSGNEDFD=$P($$GTNEDFD^PSGOE7("UI",OIDRG),"^")
 S:$P(LOC,"^")'=$P(ND2,"^",10) PSGSOY=$$ENRNAT^PSJHL7($P(ND2,"^",10),+LOC,PSGSCH,PSGSOY)
 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)
 S (PSGNESD,PSGNEFD)="" D ENWALL^PSGNE3(PSGNESD,PSGNEFD,PSJHLDFN)
 I PSGOXT="D",'PSGSOY S PSGSOY=+$E(PSGNESD_"00011",9,12)
 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
 S $P(ND,U,21)=$P(ORDER,U),$P(ND,U,24,25)=ROC_U_PREON
 F X="PSGNESD","PSGNEFD" S:@X]"" @X=+@X
 S ND2=PSGSCH_U_PSGNESD_"^^"_PSGNEFD_U_PSGSOY_U_PSGOXT
 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
 I $D(DRUGS) D
 .I $D(@(F_"1,0)")) K @(F_"1)")
 .; Naked reference below refers to full reference to ^PS(53.1,+NEWORDER in variable F created using indirection.
 .I '$D(@(F_"1,0)")) S ^(0)="^53.11P^0^0"
 .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_")")=""
 S PSJOSTOP=$G(@("^PS(55,"_PSJHLDFN_",5,"_+$G(PREON)_",2)")),PSJOSTOP=$P(PSJOSTOP,"^",4)
 D REN531(NEWORDER,$P(ND,"^",14),$S($G(PREON)["U":$P(ND,"^",2),1:$P(ND,"^",6)),PSJOSTOP,PSJHLDFN)
 ;
DONE ;
 N DA,DR,DIE,PSIVACT,PSIVALT,ON55,PSIVREA
 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)
 I PREON["A"!(PREON["U") S PSGAL("C")=18000 D ^PSGAL5
 I PREON["V" S PSIVACT=1,PSIVALT=2,ON55=PREON,PSIVREA="R"
 D ^DIE
 I PREON["V" N DFN S DFN=PSJHLDFN D LOG^PSIVORAL
 S PSJHLMTN="ORM" D EN1^PSJHL2(PSJHLDFN,"SC",PREON) S PSJHLMTN="ORR",PSOC="NW"
 Q
IVSET ;
 N DRG,DRGN,P
 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)
 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))
 S Y=$G(^PS(55,PSJHLDFN,"IV",+PREON,2)),P("LOG")=LOGIN
 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))
 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)
 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))
 D GTDRG
 S P("OT")=$S(P(4)="A":"F",P(4)="H":"I",1:"I")
 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"
PUT531 ; Move data in local variables to 53.1
 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
 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"
 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")
 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")
 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:"")
 F X=0,2,4,8,9 S ^PS(53.1,+NEWORDER,X)=ND(X)
 S:+P("PD") ^PS(53.1,+NEWORDER,.2)=+P("PD")_U_P("DO")
 S $P(^PS(53.1,+NEWORDER,.2),"^",3,4)=ORDCON_U_PRIORITY
 ;I $G(PRNTON) I $$UP^XLFSTR($G(PSGSCH))="NOW" S PRNTON=""
 I $G(PRNTON) S $P(^PS(53.1,+NEWORDER,.2),"^",8)=PRNTON
 F DRGT="AD","SOL" D:$D(DRG(DRGT)) PTD531
 S PSJOSTOP=$G(@("^PS(55,"_PSJHLDFN_",""IV"","_+PREON_",0)")),PSJOSTOP=$P(PSJOSTOP,"^",3) D
 .N IVND S IVND=$G(^PS(53.1,+NEWORDER,0)) D REN531(NEWORDER,$P(IVND,"^",14),$P(ND,"^",2),PSJOSTOP,PSJHLDFN)
 Q
PTD531 ; Move drug data from local array into 53.1
 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")
 F X=0:0 S X=$O(DRG(DRGT,X)) Q:'X  D
 .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
 .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)=""
 I $G(P("RES"))="R",($G(ND(0))]"") D REN531(+NEWORDER,$P(ND(0),"^",14),$P(ND(0),"^",2),$G(P(3)),$G(DFN))
 Q
 ;
ENRNAT(OWD,NWD,SC,OAT) ;Determine admin times for renewal orders.
 ;OWD=ORIGINAL W,NWD=NEW WD LOCATION, SC=SCHEDULE, OAT=ORDER ADMIN TIMES
 N OWAT,SCP,X,Y,OOAT
 S OOAT=OAT,SCP=+$O(^PS(51.1,"APPSJ",+SC,0)),WAT=$P($G(^PS(51.1,SCP,1,+$G(OWD),0)),U,2)
 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)))
 I OAT'=WAT Q OOAT
 S X=$P($G(^PS(51.1,+SCP,1,NWD,0)),U,2) I X Q X
 Q OOAT
 ;
GTDRG ; Get drug info and place in DRG(. 
 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
 .;Naked reference ^(Y,0) below refers to full global reference ^PS(55,PSJHLDFN,"IV",+PREON,DRGT,Y)) above at GTDRG+1
 .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)
 Q
 ;
REN531(PSGORD,PSGDT,PSGOEPR,PSGOFD,PSGP) ;
 Q:'PSGORD!'PSGDT!'PSGOEPR!'PSGOFD!'PSGP
 N DUP,PSGOLDPR I $G(PREON) D  Q:$G(DUP)
 .S:$D(^PS(53.1,+PSGORD,14,"B",+PSGDT)) DUP=1 Q
 S:$G(PREON)["U" PSGOLDPR=$P($G(^PS(55,PSGP,5,+PREON,0)),"^",2)
 S:$G(PREON)["V" PSGOLDPR=$P($G(^PS(55,PSGP,"IV",+PREON,0)),"^",6)
 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
 . 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
 K DO,DINUM
 Q
 ;
CHK(X,Y,Z) ;Check for required fields
 ; Input: X="^^"_MED ROUTE_"^^^^"_SCH TYPE
 ;        Y=ORDERABLE ITEM_"^"_DOSAGE ORDERED
 ;        Z=SCHEDULE_"^"_START DATE/TIME_"^^"_STOP DATE/TIME
 S:'$D(^PS(50.7,+Y,0)) CHK=1
 I ND="" S CHK=CHK_23
 E  S CHK=CHK_$S($P(X,"^",3):"",1:2)_$S($P(X,"^",7)]"":"",1:3)
 K PSGDFLG,PSGPFLG S PSGDI=0
 S:'$$DDOK^PSJHL10("^TMP(""PSB"","_$J_",700,",+Y) CHK=CHK_7
 ;
CHKM ;
 Q:'CHK
 N MSG2
 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)
 S PSREASON=MSG_MSG2
 Q