Changeset 636 for FOIAVistA/tag/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJLMUDE.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJLMUDE.m (modified) (8 diffs)

FOIAVistA/tag/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJLMUDE.m

@@ -1 +1 @@
 PSJLMUDE ;BIR/MLM-SHOW FIELDS FOR EDIT (LISTMAN STYLE) ;01 JUNE 00 / 2:40 PM
- ;;5.0; INPATIENT MEDICATIONS ;**7,47,50,63,64,58,80,116,110,111,164,175,201**;16 DEC 97;Build 2
-  ;NFI-UD Fr#:2 chgs@init+4 to display non-formulary (N/F)
-  ;also chgs @init+23
+ ;;5.0; INPATIENT MEDICATIONS ;**7,47,50,63,64,58,80,116,110,111,164,175**;16 DEC 97;Build 18
+ ;NFI-UD Fr#:2 chgs@init+4 to display non-formulary (N/F)
+ ;also chgs @init+23
  ;
  ; Reference to ^PS(55 is supported by DBIA# 2191
@@ -12 +12 @@
  D CLEAN^VALM10
  S PSJL=$S($D(PSGEFN(1)):$E(" *",PSGEFN(1)+1)_"(1)",1:"   "),PSJL=$$SETSTR^VALM1("Orderable Item: "_PSGPDN_$$OINF^PSJDIN(PSGPD),PSJL,5,74) D  D SETTMP D:$G(PSGOEEF(108))!($G(PSGOEEF(101))) HILITE(1)
- . NEW Q,PSJDDA,PSJVD F Q=0:0 S Q=$O(^PS(53.45,PSJSYSP,2,Q)) Q:'Q  S PSJDDA(+$G(^(Q,0)))=""
+ . N Q,PSJDDA,PSJVD F Q=0:0 S Q=$O(^PS(53.45,PSJSYSP,2,Q)) Q:'Q  S PSJDDA(+$G(^(Q,0)))=""
  . S PSJVD=$$DINFLUD^PSJDIN(PSGPD,.PSJDDA)
  . S PSJL=$$SETSTR^VALM1(PSJVD,PSJL,75,80)
  . D:PSJVD]"" CNTRL^VALM10(1,75,5,IORVON,IORVOFF,0)
  I $G(PSJORD)["P" D REQDT^PSJLIVMD(PSJORD)
- S PSJL="Instructions: "_PSGOINST D PTXT^PSJLMPRU(PSJL,"PSJUDE",6,80)
+ S PSJL="Instructions: "_PSGOINST D PTXT^PSJLMPRU(PSJL,"PSJUDE",6,120)
  S PSJL=$S($D(PSGEFN(2)):$E(" *",PSGEFN(2)+1)_"(2)",1:"    "),PSJL=$$SETSTR^VALM1("Dosage Ordered: "_PSGDO,PSJL,5,76) D SETTMP D:$G(PSGOEEF(109)) HILITE(2)
  I $G(PSGRDTX) S PSJDUR=$$FMTDUR^PSJLIVMD($P($G(PSGRDTX),U,2))
@@ -48 +48 @@
  S PSJL=$S($D(PSGEFN(9)):$E(" *",PSGEFN(9)+1)_"(9)",1:"   "),PSJL=$$SETSTR^VALM1("Admin Times: "_PSGAT,PSJL,8,71) D SETTMP D:$G(PSGOEEF(39))!($G(PSGOEEF(41))) HILITE(9)
  S PSJL=$S($D(PSGEFN(10)):$E(" *",PSGEFN(10)+1)_"(10)",1:"   "),PSJL=$$SETSTR^VALM1("Provider: "_PSGPRN,PSJL,11,68) D:$G(PSGOEEF(1)) HILITE(10) D SETTMP
- ;S PSJL=$$SETSTR^VALM1($S($D(PSGEFN(7)):$E(" *",PSGEFN(7)+1)_"(7)",1:"   ")_"Self Med: "_PSGSMN,PSJL,56,24) S:PSGSM&PSGHSM PSJL=$$SETSTR^VALM1("  (HS)",PSJL,71,7) D SETTMP D:$G(PSGOEEF(5)) HILITE(7)
  S PSJL=$S($D(PSGEFN(11)):$E(" *",PSGEFN(11))_"(11)",1:"   ")_" Special Instructions"_$S($P(PSGSI,"^",2)=1:"!: ",1:": ")_$P(PSGSI,"^") D PTXT^PSJLMPRU(PSJL,"PSJUDE",1,80)
  S PSJL="" D SETTMP D:$G(PSGOEEF(8)) HILITE(11)
@@ -54 +53 @@
  I $O(^PS(53.45,PSJSYSP,2,1)) F  S PSJL="" D SETTMP Q:PSJLN>15
  S PSJL=$S($D(PSGEFN(12)):$E(" *",PSGEFN(12))_" (12)",1:"   ")_" Dispense Drug",PSJL=$$SETSTR^VALM1("U/D",PSJL,54,60),PSJL=$$SETSTR^VALM1("Inactive Date",PSJL,65,16) D SETTMP,CNTRL^VALM10(13,1,80,IOUON,IOUOFF,0)
- ;S $P(PSJL,"-",80)="" D SETTMP
- NEW PSJX
+ N PSJX,PSGID
  F Q=0:0 S Q=$O(^PS(53.45,PSJSYSP,2,Q)) Q:'Q  S ND=$G(^(Q,0)) D
  .S D=$P(ND,"^"),PSGID=$P(ND,"^",3) I PSGID S PSGID=$$ENDTC^PSGMI(PSGID)
@@ -75 +73 @@
  .D SETTMP S PSJL="Order Checks:" D SETTMP
  .F Q=0:0 S Q=$O(^PS(53.1,+PSGORD,10,Q)) Q:'Q  D
- ..S PSJL="" D SETTMP S PSJL=$G(^PS(53.1,+PSGORD,10,Q,0)) D SETTMP
+ ..S PSJL="" D SETTMP S PSJL=$G(^PS(53.1,+PSGORD,10,Q,0)) S PSJWPL=PSJL D DISPLAY
  ..S PSJL="Overriding Provider: "_$P($G(^PS(53.1,+PSGORD,10,Q,1)),U) D SETTMP
  ..S PSJL="Overriding Reason: " F X=0:0 S X=$O(^PS(53.1,+PSGORD,10,Q,2,X)) Q:'X   D
  ...S PSJL=PSJL_$G(^PS(53.1,+PSGORD,10,Q,2,X,0)) D SETTMP S PSJL="                   "
 ACTFLG ;
+ N ND4,AT,Y,X
  S ND4=$S(PSGORD["P":$G(^PS(53.1,+PSGORD,4)),1:$G(^PS(55,PSGP,5,+PSGORD,4)))
  S AT="",Y="12,13,D,18,19,H1,22,23,H0,15,16,R" F X=1:3:12 I $P(ND4,"^",$P(Y,",",X)),$P(ND4,"^",$P(Y,",",X+1)) S AT=$P(Y,",",X+2) Q
@@ -96 +95 @@
  I $G(PSGPI) S VALMSG=$S($G(VALMSG)="":"INVALID",1:VALMSG_",")_" PROVIDER"
  Q
+ ;
 DISPLAY ;
- S PSJL=PSJWPL D SETTMP
- ;F X=1:1 S WRD=$P(PSJWPL," ",X) Q:WRD=""  D
- ;.I $L(PSJL_" "_WRD)'<80 D SETTMP S PSJL=$P(PSJWPL,PSJL,2) S:$E(PSJL,1)=" " PSJL=$E(PSJL,2,999),PSJWPL="" Q
- ;.S PSJL=PSJL_$S(PSJL="":"",1:" ")_WRD
- Q
+ N X,LEN,LIM,PCS
+ S LIM=$L(PSJWPL," "),PCS=1
+ F X=1:1:LIM S LEN=$L($P(PSJWPL," ",PCS,X)) D
+ . I LEN'<72!(X=LIM) D
+ .. S PSJL=$P(PSJWPL," ",PCS,X)
+ .. I PCS>1 S PSJL="   "_PSJL
+ .. S PCS=X+1
+ .. D SETTMP
+ Q 
  ;
 SETTMP ;
@@ -108 +112 @@
  ;
 HILITE(FLD) ; 
- N COL,LIN,WID,X
- ;Q:'$G(PSGOEENO)
+ N COL,LAB,LIN,WID,X
  S X="$T("_FLD_"^PSJLMUDE)",@("X="_X),X=$P(X,";;",2),LIN=+X,COL=$P(X,",",2),LAB=$P(X,",",3),X=$P(X,",",4),WID=(LAB+$L(@X))
- ;D CNTRL^VALM10(LIN,COL,WID,IORVON_IOBON,IOINORM,0)
  I FLD=7 S LIN=+$G(PSJLN)-1 Q:LIN<13
  D CNTRL^VALM10(LIN,COL,WID,IORVON_IOBON,IORVOFF_IOBOFF,0)
@@ -128 +130 @@
 11 ;;11,7,22,PSGSI
 ENKILL ;
- K PSGAT,PSGEB,PSGEFN,PSGFD,PSGHSM,PSGNEFD,PSGNESD,PSGOEEF,PSGOEER,PSGOFD,PSGOHSM,PSGOMR,PSGOMRN,PSGOPD,PSGOPDN,PSGOPR,PSGOSCH,PSGOSD,PSGOSM,PSGOST,PSGPD,PSGPDN,PSGPR,PSGSD,PSGSM Q
+ K PSGAT,PSGDO,PSGEB,PSGEFN,PSGFD,PSGFDN,PSGHSM,PSGNEFD,PSGNESD,PSGOEEF,PSGOEER,PSGOFD,PSGOHSM,PSGOMR,PSGMRN,PSGOPD,PSGOPDN,PSGOPR,PSGOSCH,PSGOSD
+ K PSGOSM,PSGOST,PSGPD,PSGPDN,PSGPR,PSGSD,PSGSM,PSGOINST,PSGPRN,PSGRFDN,PSGRSDN,PSGSCH,PSGSDN,PSGSI,PSGSTN,PSJWPL,RNDT
+ Q