Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VPSPUTL1

VPSPUTL1.m

Go to the documentation of this file.
  1. VPSPUTL1 ;DALOI/KML - PDO OUTPUT DISPLAY - UTILITIES ;11/20/11 15:30
  1. ;;1.0;VA POINT OF SERVICE (KIOSKS);**3**;Oct 21, 2011;Build 64
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. Q
  1. ;
  1. SETFLD(STR,VAR,COLATTR) ; -- set field in var
  1. ; INPUT
  1. ; STR : string to insert
  1. ; VAR : destination string
  1. ; COLATTR : column attributes
  1. Q $$SETSTR(STR,VAR,+$P(COLATTR,U),+$P(COLATTR,U,2))
  1. ;
  1. SETSTR(S,V,X,L) ; -- insert text(S) into variable(V)
  1. ; INPUT
  1. ; S : string to insert
  1. ; V : destination string
  1. ; X : insert @ col X
  1. ; L : clear # of chars (length)
  1. Q $E(V_$J("",X-1),1,X-1)_$E(S_$J("",L),1,L)_$E(V,X+L,999)
  1. ;
  1. ADDLN(PDONOTE,STR) ; add a line to note
  1. ; INPUT
  1. ; PDONOTE : global or local array containing the lines of the note
  1. ; STR : string of data that gets assigned to a subscript in the local or global array (PDONOTE)
  1. N L
  1. S L=$O(@PDONOTE@(""),-1)+1
  1. S @PDONOTE@(L,0)=STR
  1. Q
  1. ;
  1. PDOERR(LMRARDT,PTIEN) ; update PDO INVOCATION ERROR field when PDO was requested after the PDO INVOCABLE PERIOD
  1. ; INPUT:
  1. ; LMRARDT = Fileman date representing the last MRAR on record
  1. ; PTIEN = DFN
  1. N VPSFDA
  1. S VPSFDA(853.51,LMRARDT_","_PTIEN_",",72)="E"
  1. D FILE^DIE("","VPSFDA","")
  1. Q
  1. ;
  1. FCOMM(COM,WIDTH,NCOM) ; reformat comments to to fit in column on note
  1. ; INPUT
  1. ; COM : comments array
  1. ; WIDTH : amount of characters available for column
  1. ; OUTPUT
  1. ; NCOM : array built with the re-formatted contents of COM
  1. ; ^TMP("VPSPUTL1",$J) = maintain overall counter for comment reformatting purposes
  1. N C1,START,END,CTR,SAV,QUIT
  1. I '$D(^TMP("VPSPUTL1",$J)) S ^($J)=0
  1. S C1=0,CTR=^TMP("VPSPUTL1",$J)+1
  1. F S C1=$O(COM(C1)) Q:'C1 D
  1. . S QUIT=0,START=1
  1. . I '$D(SAV) S END=WIDTH
  1. . E S CTR=SAV
  1. . F CTR=CTR:1 S NCOM(CTR)=$G(NCOM(CTR))_$E(COM(C1),START,END) D Q:QUIT
  1. . . I NCOM(CTR)="" K NCOM(CTR) S QUIT=1 Q ; no more comments to format
  1. . . I $L(NCOM(CTR))<WIDTH S SAV=CTR S END=WIDTH-$L(NCOM(CTR)) S QUIT=1 Q ; start any next line of comments where last one left off
  1. . . S START=END+1,END=END+WIDTH
  1. S ^TMP("VPSPUTL1",$J)=CTR
  1. Q
  1. ;
  1. REACT(STAFF,LMRARDT,PTIEN,A2,COL,FLD03,NCOMM) ; format allergy reactions
  1. ; INPUT
  1. ; STAFF : is MRAR staff-facing interface ?
  1. ; LMRARDT : Fileman date representing the last MRAR on record
  1. ; PTIEN : DFN
  1. ; A2 : allergy sub-entry ien
  1. ; COL : COLUMN ATTRIBUTE ARRAY used when formatting the string for each line on the note
  1. ; FLD03 : array of reactions
  1. ; INPUT/OUTPUT:
  1. ; NCOMM : reactions and staff facing comments array formatted for display on PDO ouput
  1. ;
  1. N TEMP,ARRAY
  1. K NCOMM
  1. D FCOMM(.FLD03,$P(COL("REACTION"),U,2),.TEMP)
  1. M ARRAY=TEMP
  1. I STAFF D ALLCOMM(LMRARDT,PTIEN,A2,.COL,.ARRAY)
  1. S ^TMP("VPSPUTL1",$J)=0 D FCOMM(.ARRAY,$P(COL("REACTION"),U,2),.NCOMM)
  1. Q
  1. ;
  1. ALLCOMM(LMRARDT,PTIEN,A2,COL,ARRAY) ; format allergy section comments from staff-facing
  1. ; INPUT
  1. ; LMRARDT : Fileman date representing the last MRAR on record
  1. ; PTIEN : DFN
  1. ; A2 : allergy sub-entry ien
  1. ; COL : COLUMN ATTRIBUTE ARRAY used when formatting the string for each line on the note
  1. ; INPUT/OUTPUT
  1. ; ARRAY - reactions AND staff facing comments array formatted for display on PDO ouput
  1. ;
  1. N COMMENTS,TEMP
  1. S COMMENTS=$$GET1^DIQ(853.52,A2_","_LMRARDT_","_PTIEN_",",2,"","COMMENTS") ; staff facing staff view comments
  1. I COMMENTS]"" S COMMENTS(1)=";"_COMMENTS(1) D FCOMM(.COMMENTS,$P(COL("REACTION"),U,2),.TEMP)
  1. M ARRAY=TEMP
  1. K COMMENTS,TEMP
  1. S COMMENTS=$$GET1^DIQ(853.52,A2_","_LMRARDT_","_PTIEN_",",3,"","COMMENTS") ; staff facing vet view comments
  1. I COMMENTS]"" S COMMENTS(1)=";"_COMMENTS(1) D FCOMM(.COMMENTS,$P(COL("REACTION"),U,2),.TEMP)
  1. M ARRAY=TEMP
  1. Q
  1. ;
  1. SIG(LMRARDT,PTIEN,FLD13,COL,SIG) ; format patient instructions
  1. ; INPUT:
  1. ; LMRARDT = Fileman date representing the last MRAR on record
  1. ; PTIEN = DFN
  1. ; FLD13 - patient instructions (sig) at 853.54,13
  1. ; COL - COLUMN ATTRIBUTE ARRAY used when formatting the string for each line on the note
  1. ; INPUT/OUTPUT:
  1. ; SIG - patient instructions formatted in an array for display on PDO output
  1. K SIG
  1. N PSIG
  1. S PSIG(1)=FLD13 ; set up string into array format
  1. S ^TMP("VPSPUTL1",$J)=0
  1. D FCOMM(.PSIG,$P(COL("SIG"),U,2),.SIG)
  1. I $D(SIG(3)) S SIG(2)=$E(SIG(2),1,$P(COL("SIG"),U,2)-4)_"..." ; display just up to 2 lines of patient instructions; if 3rd line exists indicate more instructions by "..."
  1. Q
  1. ;
  1. GCOMM(LMRARDT,PTIEN,MIEN,STAFF,COL,PATCOMM) ; get unstructured comment fields and reformat to fit TIU note
  1. ; per PROVIDER FACING OUTPUT requirements; comments have a specific display format
  1. ; unstructured comments from patient facing and provider facing (staff view and vet view) can exist and are stored as discrete fields in 853.54 sub=file
  1. ; the potential exists for all 3 fields to be sent in a single MRAR session and comments about a medication need to be displayed at a specific column when
  1. ; displaying the MRAR PDO.
  1. ; INPUT:
  1. ; LMRARDT = Fileman date representing the last MRAR on record
  1. ; PTIEN = DFN
  1. ; MIEN - medication sub-entry ien
  1. ; STAFF - output represents content coming from staff-facing interface
  1. ; COL - COLUMN ATTRIBUTE ARRAY used when formatting the string for each line on the note
  1. ; INPUT/OUTPUT:
  1. ; PATCOMM - array built in this procedure that reformats word processing fields from 853.54 to fit into PDO OUTPUT (tiu note)
  1. N LSS,QUOTE,XXX,NFLD23,NFLD24,NFLD25,FLD23,FLD24,FLD25,TEMP
  1. S QUOTE=""""
  1. S FLD23=$$GET1^DIQ(853.54,MIEN_","_LMRARDT_","_PTIEN_",",23,"","FLD23") ; medication comments from patient-facing (word processing field)
  1. S FLD24=$$GET1^DIQ(853.54,MIEN_","_LMRARDT_","_PTIEN_",",24,"","FLD24") ; medication comments from staff-facing staff view (word processing field)
  1. S FLD25=$$GET1^DIQ(853.54,MIEN_","_LMRARDT_","_PTIEN_",",25,"","FLD25") ; medication comments from staff-facing vet view (word processing field)
  1. I 'STAFF,FLD23]"" D Q
  1. . S XXX=0 F S XXX=$O(FLD23(XXX)) Q:'XXX
  1. . S FLD23(1)="PATIENT COMMENTS: "_FLD23(1)
  1. . D FCOMM(.FLD23,$P(COL("COMMENTS"),U,2),.PATCOMM)
  1. ;if fields at 23&24&25 populated
  1. ;23 needs to have the 'PATIENT COMMENTS:' in front of comment string and since the comments come from patient facing it needs to be in quotes; 24 and 25 need to have a pre-pended ";"
  1. I (FLD23]"")&(FLD24]"")&(FLD25]"") D
  1. . S XXX=0 F S XXX=$O(FLD23(XXX)) Q:'XXX S LSS=XXX
  1. . S FLD23(1)="PATIENT COMMENTS: "_QUOTE_FLD23(1),FLD23(LSS)=FLD23(LSS)_QUOTE
  1. . D FCOMM(.FLD23,$P(COL("COMMENTS"),U,2),.NFLD23)
  1. . S FLD24(1)=";"_FLD24(1) D FCOMM(.FLD24,$P(COL("COMMENTS"),U,2),.NFLD24)
  1. . S FLD25(1)=";"_FLD25(1) D FCOMM(.FLD25,$P(COL("COMMENTS"),U,2),.NFLD25)
  1. . M TEMP=NFLD23,TEMP=NFLD24,TEMP=NFLD25
  1. ;if fields at 23&24&'25 populated
  1. ;23 needs to have the 'PATIENT COMMENTS:' in front of comment string and since the comments come from patient facing it needs to be in quotes; 24 needs to have a pre-pended ";"
  1. I (FLD23]"")&(FLD24]"")&(FLD25']"") D
  1. . S X=0 F S X=$O(FLD23(X)) Q:'X S LSS=X
  1. . S FLD23(1)="PATIENT COMMENTS: "_QUOTE_FLD23(1),FLD23(LSS)=FLD23(LSS)_QUOTE
  1. . D FCOMM(.FLD23,$P(COL("COMMENTS"),U,2),.NFLD23)
  1. . S FLD24(1)=";"_FLD24(1) D FCOMM(.FLD24,$P(COL("COMMENTS"),U,2),.NFLD24)
  1. . M TEMP=NFLD23,TEMP=NFLD24
  1. ; if '23&24&25
  1. ; 24 needs to have the 'PATIENT COMMENTS:' in front of comment string; 25 needs to have a pre-pended ";"
  1. I (FLD23']"")&(FLD24]"")&(FLD25]"") D
  1. . S FLD24(1)="PATIENT COMMENTS: "_FLD24(1) D FCOMM(.FLD24,$P(COL("COMMENTS"),U,2),.NFLD24)
  1. . S FLD25(1)=";"_FLD25(1) D FCOMM(.FLD25,$P(COL("COMMENTS"),U,2),.NFLD25)
  1. . M TEMP=NFLD24,TEMP=NFLD25
  1. ; if 23&'24&'25
  1. ; 23 needs to have the 'PATIENT COMMENTS:' in front of comment string and since the comments come from patient facing it needs to be in quotes
  1. I (FLD23]"")&(FLD24']"")&(FLD25']"") D
  1. . S XXX=0 F S XXX=$O(FLD23(XXX)) Q:'XXX S LSS=XXX
  1. . S FLD23(1)="PATIENT COMMENTS: "_QUOTE_FLD23(1),FLD23(LSS)=FLD23(LSS)_QUOTE
  1. . D FCOMM(.FLD23,$P(COL("COMMENTS"),U,2),.NFLD23)
  1. . M TEMP=NFLD23
  1. ;if '23&24&'25
  1. ;24 needs to have the 'PATIENT COMMENTS:' in front of comment string ;
  1. I (FLD23']"")&(FLD24]"")&(FLD25']"") D
  1. . S FLD24(1)="PATIENT COMMENTS: "_FLD24(1)
  1. . D FCOMM(.FLD24,$P(COL("COMMENTS"),U,2),.NFLD24)
  1. . M TEMP=NFLD24
  1. ;if '23&'24&25
  1. ; 25 needs to have the 'PATIENT COMMENTS:' in front of comment string
  1. I (FLD23']"")&(FLD24']"")&(FLD25]"") D
  1. . S FLD25(1)="PATIENT COMMENTS: "_FLD25(1)
  1. . D FCOMM(.FLD25,$P(COL("COMMENTS"),U,2),.NFLD25)
  1. . M TEMP=NFLD25
  1. S ^TMP("VPSPUTL1",$J)=0 D FCOMM(.TEMP,$P(COL("COMMENTS"),U,2),.PATCOMM) ; produce displayable version of comments
  1. Q