- VPSPUTL1 ;DALOI/KML - PDO OUTPUT DISPLAY - UTILITIES ;11/20/11 15:30
- ;;1.0;VA POINT OF SERVICE (KIOSKS);**3**;Oct 21, 2011;Build 64
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- Q
- ;
- SETFLD(STR,VAR,COLATTR) ; -- set field in var
- ; INPUT
- ; STR : string to insert
- ; VAR : destination string
- ; COLATTR : column attributes
- Q $$SETSTR(STR,VAR,+$P(COLATTR,U),+$P(COLATTR,U,2))
- ;
- SETSTR(S,V,X,L) ; -- insert text(S) into variable(V)
- ; INPUT
- ; S : string to insert
- ; V : destination string
- ; X : insert @ col X
- ; L : clear # of chars (length)
- Q $E(V_$J("",X-1),1,X-1)_$E(S_$J("",L),1,L)_$E(V,X+L,999)
- ;
- ADDLN(PDONOTE,STR) ; add a line to note
- ; INPUT
- ; PDONOTE : global or local array containing the lines of the note
- ; STR : string of data that gets assigned to a subscript in the local or global array (PDONOTE)
- N L
- S L=$O(@PDONOTE@(""),-1)+1
- S @PDONOTE@(L,0)=STR
- Q
- ;
- PDOERR(LMRARDT,PTIEN) ; update PDO INVOCATION ERROR field when PDO was requested after the PDO INVOCABLE PERIOD
- ; INPUT:
- ; LMRARDT = Fileman date representing the last MRAR on record
- ; PTIEN = DFN
- N VPSFDA
- S VPSFDA(853.51,LMRARDT_","_PTIEN_",",72)="E"
- D FILE^DIE("","VPSFDA","")
- Q
- ;
- FCOMM(COM,WIDTH,NCOM) ; reformat comments to to fit in column on note
- ; INPUT
- ; COM : comments array
- ; WIDTH : amount of characters available for column
- ; OUTPUT
- ; NCOM : array built with the re-formatted contents of COM
- ; ^TMP("VPSPUTL1",$J) = maintain overall counter for comment reformatting purposes
- N C1,START,END,CTR,SAV,QUIT
- I '$D(^TMP("VPSPUTL1",$J)) S ^($J)=0
- S C1=0,CTR=^TMP("VPSPUTL1",$J)+1
- F S C1=$O(COM(C1)) Q:'C1 D
- . S QUIT=0,START=1
- . I '$D(SAV) S END=WIDTH
- . E S CTR=SAV
- . F CTR=CTR:1 S NCOM(CTR)=$G(NCOM(CTR))_$E(COM(C1),START,END) D Q:QUIT
- . . I NCOM(CTR)="" K NCOM(CTR) S QUIT=1 Q ; no more comments to format
- . . 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
- . . S START=END+1,END=END+WIDTH
- S ^TMP("VPSPUTL1",$J)=CTR
- Q
- ;
- REACT(STAFF,LMRARDT,PTIEN,A2,COL,FLD03,NCOMM) ; format allergy reactions
- ; INPUT
- ; STAFF : is MRAR staff-facing interface ?
- ; LMRARDT : Fileman date representing the last MRAR on record
- ; PTIEN : DFN
- ; A2 : allergy sub-entry ien
- ; COL : COLUMN ATTRIBUTE ARRAY used when formatting the string for each line on the note
- ; FLD03 : array of reactions
- ; INPUT/OUTPUT:
- ; NCOMM : reactions and staff facing comments array formatted for display on PDO ouput
- ;
- N TEMP,ARRAY
- K NCOMM
- D FCOMM(.FLD03,$P(COL("REACTION"),U,2),.TEMP)
- M ARRAY=TEMP
- I STAFF D ALLCOMM(LMRARDT,PTIEN,A2,.COL,.ARRAY)
- S ^TMP("VPSPUTL1",$J)=0 D FCOMM(.ARRAY,$P(COL("REACTION"),U,2),.NCOMM)
- Q
- ;
- ALLCOMM(LMRARDT,PTIEN,A2,COL,ARRAY) ; format allergy section comments from staff-facing
- ; INPUT
- ; LMRARDT : Fileman date representing the last MRAR on record
- ; PTIEN : DFN
- ; A2 : allergy sub-entry ien
- ; COL : COLUMN ATTRIBUTE ARRAY used when formatting the string for each line on the note
- ; INPUT/OUTPUT
- ; ARRAY - reactions AND staff facing comments array formatted for display on PDO ouput
- ;
- N COMMENTS,TEMP
- S COMMENTS=$$GET1^DIQ(853.52,A2_","_LMRARDT_","_PTIEN_",",2,"","COMMENTS") ; staff facing staff view comments
- I COMMENTS]"" S COMMENTS(1)=";"_COMMENTS(1) D FCOMM(.COMMENTS,$P(COL("REACTION"),U,2),.TEMP)
- M ARRAY=TEMP
- K COMMENTS,TEMP
- S COMMENTS=$$GET1^DIQ(853.52,A2_","_LMRARDT_","_PTIEN_",",3,"","COMMENTS") ; staff facing vet view comments
- I COMMENTS]"" S COMMENTS(1)=";"_COMMENTS(1) D FCOMM(.COMMENTS,$P(COL("REACTION"),U,2),.TEMP)
- M ARRAY=TEMP
- Q
- ;
- SIG(LMRARDT,PTIEN,FLD13,COL,SIG) ; format patient instructions
- ; INPUT:
- ; LMRARDT = Fileman date representing the last MRAR on record
- ; PTIEN = DFN
- ; FLD13 - patient instructions (sig) at 853.54,13
- ; COL - COLUMN ATTRIBUTE ARRAY used when formatting the string for each line on the note
- ; INPUT/OUTPUT:
- ; SIG - patient instructions formatted in an array for display on PDO output
- K SIG
- N PSIG
- S PSIG(1)=FLD13 ; set up string into array format
- S ^TMP("VPSPUTL1",$J)=0
- D FCOMM(.PSIG,$P(COL("SIG"),U,2),.SIG)
- 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 "..."
- Q
- ;
- GCOMM(LMRARDT,PTIEN,MIEN,STAFF,COL,PATCOMM) ; get unstructured comment fields and reformat to fit TIU note
- ; per PROVIDER FACING OUTPUT requirements; comments have a specific display format
- ; 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
- ; 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
- ; displaying the MRAR PDO.
- ; INPUT:
- ; LMRARDT = Fileman date representing the last MRAR on record
- ; PTIEN = DFN
- ; MIEN - medication sub-entry ien
- ; STAFF - output represents content coming from staff-facing interface
- ; COL - COLUMN ATTRIBUTE ARRAY used when formatting the string for each line on the note
- ; INPUT/OUTPUT:
- ; PATCOMM - array built in this procedure that reformats word processing fields from 853.54 to fit into PDO OUTPUT (tiu note)
- N LSS,QUOTE,XXX,NFLD23,NFLD24,NFLD25,FLD23,FLD24,FLD25,TEMP
- S QUOTE=""""
- S FLD23=$$GET1^DIQ(853.54,MIEN_","_LMRARDT_","_PTIEN_",",23,"","FLD23") ; medication comments from patient-facing (word processing field)
- S FLD24=$$GET1^DIQ(853.54,MIEN_","_LMRARDT_","_PTIEN_",",24,"","FLD24") ; medication comments from staff-facing staff view (word processing field)
- S FLD25=$$GET1^DIQ(853.54,MIEN_","_LMRARDT_","_PTIEN_",",25,"","FLD25") ; medication comments from staff-facing vet view (word processing field)
- I 'STAFF,FLD23]"" D Q
- . S XXX=0 F S XXX=$O(FLD23(XXX)) Q:'XXX
- . S FLD23(1)="PATIENT COMMENTS: "_FLD23(1)
- . D FCOMM(.FLD23,$P(COL("COMMENTS"),U,2),.PATCOMM)
- ;if fields at 23&24&25 populated
- ;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 ";"
- I (FLD23]"")&(FLD24]"")&(FLD25]"") D
- . S XXX=0 F S XXX=$O(FLD23(XXX)) Q:'XXX S LSS=XXX
- . S FLD23(1)="PATIENT COMMENTS: "_QUOTE_FLD23(1),FLD23(LSS)=FLD23(LSS)_QUOTE
- . D FCOMM(.FLD23,$P(COL("COMMENTS"),U,2),.NFLD23)
- . S FLD24(1)=";"_FLD24(1) D FCOMM(.FLD24,$P(COL("COMMENTS"),U,2),.NFLD24)
- . S FLD25(1)=";"_FLD25(1) D FCOMM(.FLD25,$P(COL("COMMENTS"),U,2),.NFLD25)
- . M TEMP=NFLD23,TEMP=NFLD24,TEMP=NFLD25
- ;if fields at 23&24&'25 populated
- ;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 ";"
- I (FLD23]"")&(FLD24]"")&(FLD25']"") D
- . S X=0 F S X=$O(FLD23(X)) Q:'X S LSS=X
- . S FLD23(1)="PATIENT COMMENTS: "_QUOTE_FLD23(1),FLD23(LSS)=FLD23(LSS)_QUOTE
- . D FCOMM(.FLD23,$P(COL("COMMENTS"),U,2),.NFLD23)
- . S FLD24(1)=";"_FLD24(1) D FCOMM(.FLD24,$P(COL("COMMENTS"),U,2),.NFLD24)
- . M TEMP=NFLD23,TEMP=NFLD24
- ; if '23&24&25
- ; 24 needs to have the 'PATIENT COMMENTS:' in front of comment string; 25 needs to have a pre-pended ";"
- I (FLD23']"")&(FLD24]"")&(FLD25]"") D
- . S FLD24(1)="PATIENT COMMENTS: "_FLD24(1) D FCOMM(.FLD24,$P(COL("COMMENTS"),U,2),.NFLD24)
- . S FLD25(1)=";"_FLD25(1) D FCOMM(.FLD25,$P(COL("COMMENTS"),U,2),.NFLD25)
- . M TEMP=NFLD24,TEMP=NFLD25
- ; if 23&'24&'25
- ; 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
- I (FLD23]"")&(FLD24']"")&(FLD25']"") D
- . S XXX=0 F S XXX=$O(FLD23(XXX)) Q:'XXX S LSS=XXX
- . S FLD23(1)="PATIENT COMMENTS: "_QUOTE_FLD23(1),FLD23(LSS)=FLD23(LSS)_QUOTE
- . D FCOMM(.FLD23,$P(COL("COMMENTS"),U,2),.NFLD23)
- . M TEMP=NFLD23
- ;if '23&24&'25
- ;24 needs to have the 'PATIENT COMMENTS:' in front of comment string ;
- I (FLD23']"")&(FLD24]"")&(FLD25']"") D
- . S FLD24(1)="PATIENT COMMENTS: "_FLD24(1)
- . D FCOMM(.FLD24,$P(COL("COMMENTS"),U,2),.NFLD24)
- . M TEMP=NFLD24
- ;if '23&'24&25
- ; 25 needs to have the 'PATIENT COMMENTS:' in front of comment string
- I (FLD23']"")&(FLD24']"")&(FLD25]"") D
- . S FLD25(1)="PATIENT COMMENTS: "_FLD25(1)
- . D FCOMM(.FLD25,$P(COL("COMMENTS"),U,2),.NFLD25)
- . M TEMP=NFLD25
- S ^TMP("VPSPUTL1",$J)=0 D FCOMM(.TEMP,$P(COL("COMMENTS"),U,2),.PATCOMM) ; produce displayable version of comments
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPSPUTL1 8749 printed Jan 18, 2025@03:44:29 Page 2
- 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
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;
- +4 QUIT
- +5 ;
- SETFLD(STR,VAR,COLATTR) ; -- set field in var
- +1 ; INPUT
- +2 ; STR : string to insert
- +3 ; VAR : destination string
- +4 ; COLATTR : column attributes
- +5 QUIT $$SETSTR(STR,VAR,+$PIECE(COLATTR,U),+$PIECE(COLATTR,U,2))
- +6 ;
- SETSTR(S,V,X,L) ; -- insert text(S) into variable(V)
- +1 ; INPUT
- +2 ; S : string to insert
- +3 ; V : destination string
- +4 ; X : insert @ col X
- +5 ; L : clear # of chars (length)
- +6 QUIT $EXTRACT(V_$JUSTIFY("",X-1),1,X-1)_$EXTRACT(S_$JUSTIFY("",L),1,L)_$EXTRACT(V,X+L,999)
- +7 ;
- ADDLN(PDONOTE,STR) ; add a line to note
- +1 ; INPUT
- +2 ; PDONOTE : global or local array containing the lines of the note
- +3 ; STR : string of data that gets assigned to a subscript in the local or global array (PDONOTE)
- +4 NEW L
- +5 SET L=$ORDER(@PDONOTE@(""),-1)+1
- +6 SET @PDONOTE@(L,0)=STR
- +7 QUIT
- +8 ;
- PDOERR(LMRARDT,PTIEN) ; update PDO INVOCATION ERROR field when PDO was requested after the PDO INVOCABLE PERIOD
- +1 ; INPUT:
- +2 ; LMRARDT = Fileman date representing the last MRAR on record
- +3 ; PTIEN = DFN
- +4 NEW VPSFDA
- +5 SET VPSFDA(853.51,LMRARDT_","_PTIEN_",",72)="E"
- +6 DO FILE^DIE("","VPSFDA","")
- +7 QUIT
- +8 ;
- FCOMM(COM,WIDTH,NCOM) ; reformat comments to to fit in column on note
- +1 ; INPUT
- +2 ; COM : comments array
- +3 ; WIDTH : amount of characters available for column
- +4 ; OUTPUT
- +5 ; NCOM : array built with the re-formatted contents of COM
- +6 ; ^TMP("VPSPUTL1",$J) = maintain overall counter for comment reformatting purposes
- +7 NEW C1,START,END,CTR,SAV,QUIT
- +8 IF '$DATA(^TMP("VPSPUTL1",$JOB))
- SET ^($JOB)=0
- +9 SET C1=0
- SET CTR=^TMP("VPSPUTL1",$JOB)+1
- +10 FOR
- SET C1=$ORDER(COM(C1))
- if 'C1
- QUIT
- Begin DoDot:1
- +11 SET QUIT=0
- SET START=1
- +12 IF '$DATA(SAV)
- SET END=WIDTH
- +13 IF '$TEST
- SET CTR=SAV
- +14 FOR CTR=CTR:1
- SET NCOM(CTR)=$GET(NCOM(CTR))_$EXTRACT(COM(C1),START,END)
- Begin DoDot:2
- +15 ; no more comments to format
- IF NCOM(CTR)=""
- KILL NCOM(CTR)
- SET QUIT=1
- QUIT
- +16 ; start any next line of comments where last one left off
- IF $LENGTH(NCOM(CTR))<WIDTH
- SET SAV=CTR
- SET END=WIDTH-$LENGTH(NCOM(CTR))
- SET QUIT=1
- QUIT
- +17 SET START=END+1
- SET END=END+WIDTH
- End DoDot:2
- if QUIT
- QUIT
- End DoDot:1
- +18 SET ^TMP("VPSPUTL1",$JOB)=CTR
- +19 QUIT
- +20 ;
- REACT(STAFF,LMRARDT,PTIEN,A2,COL,FLD03,NCOMM) ; format allergy reactions
- +1 ; INPUT
- +2 ; STAFF : is MRAR staff-facing interface ?
- +3 ; LMRARDT : Fileman date representing the last MRAR on record
- +4 ; PTIEN : DFN
- +5 ; A2 : allergy sub-entry ien
- +6 ; COL : COLUMN ATTRIBUTE ARRAY used when formatting the string for each line on the note
- +7 ; FLD03 : array of reactions
- +8 ; INPUT/OUTPUT:
- +9 ; NCOMM : reactions and staff facing comments array formatted for display on PDO ouput
- +10 ;
- +11 NEW TEMP,ARRAY
- +12 KILL NCOMM
- +13 DO FCOMM(.FLD03,$PIECE(COL("REACTION"),U,2),.TEMP)
- +14 MERGE ARRAY=TEMP
- +15 IF STAFF
- DO ALLCOMM(LMRARDT,PTIEN,A2,.COL,.ARRAY)
- +16 SET ^TMP("VPSPUTL1",$JOB)=0
- DO FCOMM(.ARRAY,$PIECE(COL("REACTION"),U,2),.NCOMM)
- +17 QUIT
- +18 ;
- ALLCOMM(LMRARDT,PTIEN,A2,COL,ARRAY) ; format allergy section comments from staff-facing
- +1 ; INPUT
- +2 ; LMRARDT : Fileman date representing the last MRAR on record
- +3 ; PTIEN : DFN
- +4 ; A2 : allergy sub-entry ien
- +5 ; COL : COLUMN ATTRIBUTE ARRAY used when formatting the string for each line on the note
- +6 ; INPUT/OUTPUT
- +7 ; ARRAY - reactions AND staff facing comments array formatted for display on PDO ouput
- +8 ;
- +9 NEW COMMENTS,TEMP
- +10 ; staff facing staff view comments
- SET COMMENTS=$$GET1^DIQ(853.52,A2_","_LMRARDT_","_PTIEN_",",2,"","COMMENTS")
- +11 IF COMMENTS]""
- SET COMMENTS(1)=";"_COMMENTS(1)
- DO FCOMM(.COMMENTS,$PIECE(COL("REACTION"),U,2),.TEMP)
- +12 MERGE ARRAY=TEMP
- +13 KILL COMMENTS,TEMP
- +14 ; staff facing vet view comments
- SET COMMENTS=$$GET1^DIQ(853.52,A2_","_LMRARDT_","_PTIEN_",",3,"","COMMENTS")
- +15 IF COMMENTS]""
- SET COMMENTS(1)=";"_COMMENTS(1)
- DO FCOMM(.COMMENTS,$PIECE(COL("REACTION"),U,2),.TEMP)
- +16 MERGE ARRAY=TEMP
- +17 QUIT
- +18 ;
- SIG(LMRARDT,PTIEN,FLD13,COL,SIG) ; format patient instructions
- +1 ; INPUT:
- +2 ; LMRARDT = Fileman date representing the last MRAR on record
- +3 ; PTIEN = DFN
- +4 ; FLD13 - patient instructions (sig) at 853.54,13
- +5 ; COL - COLUMN ATTRIBUTE ARRAY used when formatting the string for each line on the note
- +6 ; INPUT/OUTPUT:
- +7 ; SIG - patient instructions formatted in an array for display on PDO output
- +8 KILL SIG
- +9 NEW PSIG
- +10 ; set up string into array format
- SET PSIG(1)=FLD13
- +11 SET ^TMP("VPSPUTL1",$JOB)=0
- +12 DO FCOMM(.PSIG,$PIECE(COL("SIG"),U,2),.SIG)
- +13 ; display just up to 2 lines of patient instructions; if 3rd line exists indicate more instructions by "..."
- IF $DATA(SIG(3))
- SET SIG(2)=$EXTRACT(SIG(2),1,$PIECE(COL("SIG"),U,2)-4)_"..."
- +14 QUIT
- +15 ;
- 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
- +2 ; 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
- +3 ; 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
- +4 ; displaying the MRAR PDO.
- +5 ; INPUT:
- +6 ; LMRARDT = Fileman date representing the last MRAR on record
- +7 ; PTIEN = DFN
- +8 ; MIEN - medication sub-entry ien
- +9 ; STAFF - output represents content coming from staff-facing interface
- +10 ; COL - COLUMN ATTRIBUTE ARRAY used when formatting the string for each line on the note
- +11 ; INPUT/OUTPUT:
- +12 ; PATCOMM - array built in this procedure that reformats word processing fields from 853.54 to fit into PDO OUTPUT (tiu note)
- +13 NEW LSS,QUOTE,XXX,NFLD23,NFLD24,NFLD25,FLD23,FLD24,FLD25,TEMP
- +14 SET QUOTE=""""
- +15 ; medication comments from patient-facing (word processing field)
- SET FLD23=$$GET1^DIQ(853.54,MIEN_","_LMRARDT_","_PTIEN_",",23,"","FLD23")
- +16 ; medication comments from staff-facing staff view (word processing field)
- SET FLD24=$$GET1^DIQ(853.54,MIEN_","_LMRARDT_","_PTIEN_",",24,"","FLD24")
- +17 ; medication comments from staff-facing vet view (word processing field)
- SET FLD25=$$GET1^DIQ(853.54,MIEN_","_LMRARDT_","_PTIEN_",",25,"","FLD25")
- +18 IF 'STAFF
- IF FLD23]""
- Begin DoDot:1
- +19 SET XXX=0
- FOR
- SET XXX=$ORDER(FLD23(XXX))
- if 'XXX
- QUIT
- +20 SET FLD23(1)="PATIENT COMMENTS: "_FLD23(1)
- +21 DO FCOMM(.FLD23,$PIECE(COL("COMMENTS"),U,2),.PATCOMM)
- End DoDot:1
- QUIT
- +22 ;if fields at 23&24&25 populated
- +23 ;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 ";"
- +24 IF (FLD23]"")&(FLD24]"")&(FLD25]"")
- Begin DoDot:1
- +25 SET XXX=0
- FOR
- SET XXX=$ORDER(FLD23(XXX))
- if 'XXX
- QUIT
- SET LSS=XXX
- +26 SET FLD23(1)="PATIENT COMMENTS: "_QUOTE_FLD23(1)
- SET FLD23(LSS)=FLD23(LSS)_QUOTE
- +27 DO FCOMM(.FLD23,$PIECE(COL("COMMENTS"),U,2),.NFLD23)
- +28 SET FLD24(1)=";"_FLD24(1)
- DO FCOMM(.FLD24,$PIECE(COL("COMMENTS"),U,2),.NFLD24)
- +29 SET FLD25(1)=";"_FLD25(1)
- DO FCOMM(.FLD25,$PIECE(COL("COMMENTS"),U,2),.NFLD25)
- +30 MERGE TEMP=NFLD23,TEMP=NFLD24,TEMP=NFLD25
- End DoDot:1
- +31 ;if fields at 23&24&'25 populated
- +32 ;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 ";"
- +33 IF (FLD23]"")&(FLD24]"")&(FLD25']"")
- Begin DoDot:1
- +34 SET X=0
- FOR
- SET X=$ORDER(FLD23(X))
- if 'X
- QUIT
- SET LSS=X
- +35 SET FLD23(1)="PATIENT COMMENTS: "_QUOTE_FLD23(1)
- SET FLD23(LSS)=FLD23(LSS)_QUOTE
- +36 DO FCOMM(.FLD23,$PIECE(COL("COMMENTS"),U,2),.NFLD23)
- +37 SET FLD24(1)=";"_FLD24(1)
- DO FCOMM(.FLD24,$PIECE(COL("COMMENTS"),U,2),.NFLD24)
- +38 MERGE TEMP=NFLD23,TEMP=NFLD24
- End DoDot:1
- +39 ; if '23&24&25
- +40 ; 24 needs to have the 'PATIENT COMMENTS:' in front of comment string; 25 needs to have a pre-pended ";"
- +41 IF (FLD23']"")&(FLD24]"")&(FLD25]"")
- Begin DoDot:1
- +42 SET FLD24(1)="PATIENT COMMENTS: "_FLD24(1)
- DO FCOMM(.FLD24,$PIECE(COL("COMMENTS"),U,2),.NFLD24)
- +43 SET FLD25(1)=";"_FLD25(1)
- DO FCOMM(.FLD25,$PIECE(COL("COMMENTS"),U,2),.NFLD25)
- +44 MERGE TEMP=NFLD24,TEMP=NFLD25
- End DoDot:1
- +45 ; if 23&'24&'25
- +46 ; 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
- +47 IF (FLD23]"")&(FLD24']"")&(FLD25']"")
- Begin DoDot:1
- +48 SET XXX=0
- FOR
- SET XXX=$ORDER(FLD23(XXX))
- if 'XXX
- QUIT
- SET LSS=XXX
- +49 SET FLD23(1)="PATIENT COMMENTS: "_QUOTE_FLD23(1)
- SET FLD23(LSS)=FLD23(LSS)_QUOTE
- +50 DO FCOMM(.FLD23,$PIECE(COL("COMMENTS"),U,2),.NFLD23)
- +51 MERGE TEMP=NFLD23
- End DoDot:1
- +52 ;if '23&24&'25
- +53 ;24 needs to have the 'PATIENT COMMENTS:' in front of comment string ;
- +54 IF (FLD23']"")&(FLD24]"")&(FLD25']"")
- Begin DoDot:1
- +55 SET FLD24(1)="PATIENT COMMENTS: "_FLD24(1)
- +56 DO FCOMM(.FLD24,$PIECE(COL("COMMENTS"),U,2),.NFLD24)
- +57 MERGE TEMP=NFLD24
- End DoDot:1
- +58 ;if '23&'24&25
- +59 ; 25 needs to have the 'PATIENT COMMENTS:' in front of comment string
- +60 IF (FLD23']"")&(FLD24']"")&(FLD25]"")
- Begin DoDot:1
- +61 SET FLD25(1)="PATIENT COMMENTS: "_FLD25(1)
- +62 DO FCOMM(.FLD25,$PIECE(COL("COMMENTS"),U,2),.NFLD25)
- +63 MERGE TEMP=NFLD25
- End DoDot:1
- +64 ; produce displayable version of comments
- SET ^TMP("VPSPUTL1",$JOB)=0
- DO FCOMM(.TEMP,$PIECE(COL("COMMENTS"),U,2),.PATCOMM)
- +65 QUIT