BPMXWP ;IHS/PHXAO/AEF - PROCESS WORD PROCESSING FIELDS - 6/26/12 ;
;;1.0;IHS PATIENT MERGE;**2**;MAR 01, 2010;Build 1
;IHS/OIT/LJF 10/26/2006 routine originated from Phoenix Area Office
; changed namespace from BZXM to BPM
;IHS/OIT/NKD 6/13/2012 Added DT to WP's 3rd piece in 0 node
; Removed ^GMR processing
; Delete WP after merging
; Create an entry in the parent file if none existed
;;
DESC ;----- ROUTINE DESCRIPTION
;;
;;BPMXWP:
;;THIS ROUTINE MERGES THE CONTENTS OF THE SPECIFIED WORD PROCESSING
;;FIELD FOR THE SPECIFIED ENTRY FOR DINUM'ED FILES.
;;
;;THIS ROUTINE IS CALLED BY THE SPECIAL MERGE ROUTINE DRIVER - ^BPMXDRV
;;
;;THE IHS PATIENT MERGE SOFTWARE ENTERS AT EN LINE LABEL. IT IS EXPECTED
;;THAT THE FOLLOWING GLOBAL WOULD HAVE BEEN SET UP BY THE PATIENT MERGE
;;SOFTWARE:
;; ^TMP("XDRFROM",$J,FROMIEN,TOIEN,FROMIEN_GLOBROOT,TOIEN_GLOBROOT)=FILE
;;EXAMPLE:
;; ^TMP("XDRFROM",2804,6364,1991,"6364;DPT(","1991;DPT(")=2
;;WHERE =2 IS THE PARENT FILE (VA PATIENT FILE).
;;
;;$$END
;
N I,X F I=1:1 S X=$P($T(DESC+I),";;",2) Q:X["$$END" D EN^DDIOL(X)
Q
EN(BPMRY) ;EP
;----- MAIN ENTRY POINT FROM DUPLICATE PATIENT MERGE SOFTWARE
;
; BPMRY = TEMP GLOBAL SET UP BY THE PATIENT MERGE SOFTWARE,
; I.E., "^TMP(""XDRFROM"",$J)"
;
N BPMFR,BPMTO
;
S BPMFR=$O(@BPMRY@(0))
Q:'BPMFR
S BPMTO=$O(@BPMRY@(BPMFR,0))
Q:'BPMTO
;
D PROC(BPMFR,BPMTO)
Q
PROC(BPMFR,BPMTO) ;
;----- PROCESS WP FIELDS
;
N I,FLD
;
F I=1:1 S FLD=$P($T(WPFLDS+I),";;",2) Q:FLD["$$END" D
. D ONE(BPMFR,BPMTO,FLD)
Q
ONE(BPMFR,BPMTO,FLD) ;
;----- PROCESS ONE WP FIELD
;
K ^TMP("BPM",$J)
;
D GET(BPMFR,FLD)
Q:'$D(^TMP("BPM",$J))
D PUT(BPMTO,FLD)
;
K ^TMP("BPM",$J)
;
Q
GET(IEN,FLD) ;
;----- GET TEXT FROM WP FIELD
;
N G,Z,DA,DIK,DO,DD
;
S G=$P(FLD,";")_IEN_","_$P(FLD,";",2)_","
S Z=0
F S Z=$O(@(G_Z_")")) Q:'Z D
. S ^TMP("BPM",$J,Z)=@(G_Z_",0)")
;IHS/OIT/NKD BPM*1.0*2 REMOVE WP DATA AFTER STORING
K @($P(FLD,";")_IEN_","_$P(FLD,";",2)_")")
Q
PUT(IEN,FLD) ;
;----- PUT TEXT INTO WP FIELD
;
;IHS/OIT/NKD BPM*1.0*2 CREATE PARENT FILE ENTRY IF NONE EXISTED
I '$D(@($P(FLD,";")_IEN_",0)")) D
. N DIC,X,DINUM
. S DIC=$P(FLD,";"),DIC(0)=""
. S X=IEN,DINUM=X
. K DD,DO
. D FILE^DICN
;
N D1,G,Z
;
S G=$P(FLD,";")_IEN_","_$P(FLD,";",2)_","
S D1=+$P($G(@(G_"0)")),U,3)
S Z=0
F S Z=$O(^TMP("BPM",$J,Z)) Q:'Z D
. S D1=D1+1
. S @(G_D1_",0)")=^TMP("BPM",$J,Z)
. ;IHS/OIT/NKD BPM*1.0*2 ADD DT TO 3RD PIECE
. S $P(@(G_"0)"),U,3,5)=D1_U_D1_U_$$DT^XLFDT()
Q
WPFLDS ;----- LIST OF WORD PROCESSING FIELDS TO BE MERGED - GBLROOT;SUBSCRPT
;;^AUPNPAT(;12;LOCATION OF HOME FIELD IN PATIENT FILE
;;^AUPNPAT(;13;ADDITIONAL REGISTRATION INFO FIELD IN PATIENT FILE
;;^AUPNPAT(;14;REMARKS FIELD IN PATIENT FILE
;;^AUPNPAT(;15;ALERTS FIELD IN PATIENT FILE
;;^AUPNPAT(;16;CHS NOTES FIELD IN PATIENT FILE
;;^BATREG(;11;NOTES/COMMENTS FIELD IN ASTHMA REGISTER FILE
;;^AMHPINTK(;10;REFERRED BY FIELD IN MHSS INTAKE FILE
;;^AMHPINTK(;11;INFORMANTS INCLUDE FIELD IN MHSS INTAKE FILE
;;^AMHPINTK(;12;HISTORY OF PRESENTING PROBLEM FIELD IN MHSS INTAKE FILE
;;^AMHPINTK(;13;PAST PSYCHIATRIC HISTORY FIELD IN MHSS INTAKE FILE
;;^AMHPINTK(;14;DRUG/ALCOHOL HISTORY FIELD IN MHSS INTAKE FILE
;;^AMHPINTK(;15;LEGAL HISTORY FIELD IN MHSS INTAKE FILE
;;^AMHPINTK(;16;SOCIAL HISTORY FIELD IN MHSS INTAKE FILE
;;^AMHPINTK(;17;MEDICAL HISTORY FIELD IN MHSS INTAKE FILE
;;^AMHPINTK(;18;CURRENT MEDICATIONS FIELD IN MHSS INTAKE FILE
;;^AMHPINTK(;19;MENTAL STATUS EXAM FIELD IN MHSS INTAKE FILE
;;^AMHPINTK(;21;IMPRESSION/FORMULATION FIELD IN MHSS INTAKE FILE
;;^AMHPINTK(;22;DEVELOPMENTAL HISTORY FIELD IN MHSS INTAKE FILE
;;^AMHPINTK(;23;EDUCATIONAL HISTORY FIELD IN MHSS INTAKE FILE
;;^AMHPINTK(;24;FAMILY HISTORY FIELD IN MHSS INTAKE FILE
;;^AMHPINTK(;25;VOCATIONAL HISTORY FIELD IN MHSS INTAKE FILE
;;^AMHPINTK(;26;HOBBIES FIELD IN MHSS INTAKE FILE
;;^AMHPINTK(;27;STRENGTHS/RESOURCES FIELD IN MHSS INTAKE FILE
;;^AMHPINTK(;28;INITIAL PLAN FIELD IN MHSS INTAKE FILE
;;^AMHPINTK(;41;INTAKE DOCUMENTATION/NARRATIVE FIELD IN MHSS INTAKE FILE
;;^BIP(;1;IMM/SERVE TEXT FIELD IN BI PATIENT FILE
;;^BWP(;1;NOTES FIELD IN BW PATIENT FILE
;;^PS(55,;5.2;COMMENTS FIELD IN PHARMACY PATIENT FILE
;;^SCPT(404.41,;"C";COMMENTS FIELD IN OUTPATIENT PROFILE FILE
;;^ABSPE(;"TRANS";TRANSMISSION RAW DATA FIELD IN ABSP ELIGIBILITY FILE
;;^ABSPE(;"RESP";RESPONSE RAW DATA FIELD IN ABSP ELIGIBILITY FILE
;;$$END
;;^GMR(126,;"IN";INTAKE FIELD IN GMRY PATIENT I/0 FILE
;;^GMR(126,;"IV";IV FIELD IN GMRY PATIENT I/O FILE
;;^GMR(126,;"OUT";OUTPUT FIELD IN GMRY PATIENT I/O FILE
BPMXWP ;IHS/PHXAO/AEF - PROCESS WORD PROCESSING FIELDS - 6/26/12 ;
+1 ;;1.0;IHS PATIENT MERGE;**2**;MAR 01, 2010;Build 1
+2 ;IHS/OIT/LJF 10/26/2006 routine originated from Phoenix Area Office
+3 ; changed namespace from BZXM to BPM
+4 ;IHS/OIT/NKD 6/13/2012 Added DT to WP's 3rd piece in 0 node
+5 ; Removed ^GMR processing
+6 ; Delete WP after merging
+7 ; Create an entry in the parent file if none existed
+8 ;;
DESC ;----- ROUTINE DESCRIPTION
+1 ;;
+2 ;;BPMXWP:
+3 ;;THIS ROUTINE MERGES THE CONTENTS OF THE SPECIFIED WORD PROCESSING
+4 ;;FIELD FOR THE SPECIFIED ENTRY FOR DINUM'ED FILES.
+5 ;;
+6 ;;THIS ROUTINE IS CALLED BY THE SPECIAL MERGE ROUTINE DRIVER - ^BPMXDRV
+7 ;;
+8 ;;THE IHS PATIENT MERGE SOFTWARE ENTERS AT EN LINE LABEL. IT IS EXPECTED
+9 ;;THAT THE FOLLOWING GLOBAL WOULD HAVE BEEN SET UP BY THE PATIENT MERGE
+10 ;;SOFTWARE:
+11 ;; ^TMP("XDRFROM",$J,FROMIEN,TOIEN,FROMIEN_GLOBROOT,TOIEN_GLOBROOT)=FILE
+12 ;;EXAMPLE:
+13 ;; ^TMP("XDRFROM",2804,6364,1991,"6364;DPT(","1991;DPT(")=2
+14 ;;WHERE =2 IS THE PARENT FILE (VA PATIENT FILE).
+15 ;;
+16 ;;$$END
+17 ;
+18 NEW I,X
FOR I=1:1
SET X=$PIECE($TEXT(DESC+I),";;",2)
IF X["$$END"
QUIT
DO EN^DDIOL(X)
+19 QUIT
EN(BPMRY) ;EP
+1 ;----- MAIN ENTRY POINT FROM DUPLICATE PATIENT MERGE SOFTWARE
+2 ;
+3 ; BPMRY = TEMP GLOBAL SET UP BY THE PATIENT MERGE SOFTWARE,
+4 ; I.E., "^TMP(""XDRFROM"",$J)"
+5 ;
+6 NEW BPMFR,BPMTO
+7 ;
+8 SET BPMFR=$ORDER(@BPMRY@(0))
+9 IF 'BPMFR
QUIT
+10 SET BPMTO=$ORDER(@BPMRY@(BPMFR,0))
+11 IF 'BPMTO
QUIT
+12 ;
+13 DO PROC(BPMFR,BPMTO)
+14 QUIT
PROC(BPMFR,BPMTO) ;
+1 ;----- PROCESS WP FIELDS
+2 ;
+3 NEW I,FLD
+4 ;
+5 FOR I=1:1
SET FLD=$PIECE($TEXT(WPFLDS+I),";;",2)
IF FLD["$$END"
QUIT
Begin DoDot:1
+6 DO ONE(BPMFR,BPMTO,FLD)
End DoDot:1
+7 QUIT
ONE(BPMFR,BPMTO,FLD) ;
+1 ;----- PROCESS ONE WP FIELD
+2 ;
+3 KILL ^TMP("BPM",$JOB)
+4 ;
+5 DO GET(BPMFR,FLD)
+6 IF '$DATA(^TMP("BPM",$JOB))
QUIT
+7 DO PUT(BPMTO,FLD)
+8 ;
+9 KILL ^TMP("BPM",$JOB)
+10 ;
+11 QUIT
GET(IEN,FLD) ;
+1 ;----- GET TEXT FROM WP FIELD
+2 ;
+3 NEW G,Z,DA,DIK,DO,DD
+4 ;
+5 SET G=$PIECE(FLD,";")_IEN_","_$PIECE(FLD,";",2)_","
+6 SET Z=0
+7 FOR
SET Z=$ORDER(@(G_Z_")"))
IF 'Z
QUIT
Begin DoDot:1
+8 SET ^TMP("BPM",$JOB,Z)=@(G_Z_",0)")
End DoDot:1
+9 ;IHS/OIT/NKD BPM*1.0*2 REMOVE WP DATA AFTER STORING
+10 KILL @($PIECE(FLD,";")_IEN_","_$PIECE(FLD,";",2)_")")
+11 QUIT
PUT(IEN,FLD) ;
+1 ;----- PUT TEXT INTO WP FIELD
+2 ;
+3 ;IHS/OIT/NKD BPM*1.0*2 CREATE PARENT FILE ENTRY IF NONE EXISTED
+4 IF '$DATA(@($PIECE(FLD,";")_IEN_",0)"))
Begin DoDot:1
+5 NEW DIC,X,DINUM
+6 SET DIC=$PIECE(FLD,";")
SET DIC(0)=""
+7 SET X=IEN
SET DINUM=X
+8 KILL DD,DO
+9 DO FILE^DICN
End DoDot:1
+10 ;
+11 NEW D1,G,Z
+12 ;
+13 SET G=$PIECE(FLD,";")_IEN_","_$PIECE(FLD,";",2)_","
+14 SET D1=+$PIECE($GET(@(G_"0)")),U,3)
+15 SET Z=0
+16 FOR
SET Z=$ORDER(^TMP("BPM",$JOB,Z))
IF 'Z
QUIT
Begin DoDot:1
+17 SET D1=D1+1
+18 SET @(G_D1_",0)")=^TMP("BPM",$JOB,Z)
+19 ;IHS/OIT/NKD BPM*1.0*2 ADD DT TO 3RD PIECE
+20 SET $PIECE(@(G_"0)"),U,3,5)=D1_U_D1_U_$$DT^XLFDT()
End DoDot:1
+21 QUIT
WPFLDS ;----- LIST OF WORD PROCESSING FIELDS TO BE MERGED - GBLROOT;SUBSCRPT
+1 ;;^AUPNPAT(;12;LOCATION OF HOME FIELD IN PATIENT FILE
+2 ;;^AUPNPAT(;13;ADDITIONAL REGISTRATION INFO FIELD IN PATIENT FILE
+3 ;;^AUPNPAT(;14;REMARKS FIELD IN PATIENT FILE
+4 ;;^AUPNPAT(;15;ALERTS FIELD IN PATIENT FILE
+5 ;;^AUPNPAT(;16;CHS NOTES FIELD IN PATIENT FILE
+6 ;;^BATREG(;11;NOTES/COMMENTS FIELD IN ASTHMA REGISTER FILE
+7 ;;^AMHPINTK(;10;REFERRED BY FIELD IN MHSS INTAKE FILE
+8 ;;^AMHPINTK(;11;INFORMANTS INCLUDE FIELD IN MHSS INTAKE FILE
+9 ;;^AMHPINTK(;12;HISTORY OF PRESENTING PROBLEM FIELD IN MHSS INTAKE FILE
+10 ;;^AMHPINTK(;13;PAST PSYCHIATRIC HISTORY FIELD IN MHSS INTAKE FILE
+11 ;;^AMHPINTK(;14;DRUG/ALCOHOL HISTORY FIELD IN MHSS INTAKE FILE
+12 ;;^AMHPINTK(;15;LEGAL HISTORY FIELD IN MHSS INTAKE FILE
+13 ;;^AMHPINTK(;16;SOCIAL HISTORY FIELD IN MHSS INTAKE FILE
+14 ;;^AMHPINTK(;17;MEDICAL HISTORY FIELD IN MHSS INTAKE FILE
+15 ;;^AMHPINTK(;18;CURRENT MEDICATIONS FIELD IN MHSS INTAKE FILE
+16 ;;^AMHPINTK(;19;MENTAL STATUS EXAM FIELD IN MHSS INTAKE FILE
+17 ;;^AMHPINTK(;21;IMPRESSION/FORMULATION FIELD IN MHSS INTAKE FILE
+18 ;;^AMHPINTK(;22;DEVELOPMENTAL HISTORY FIELD IN MHSS INTAKE FILE
+19 ;;^AMHPINTK(;23;EDUCATIONAL HISTORY FIELD IN MHSS INTAKE FILE
+20 ;;^AMHPINTK(;24;FAMILY HISTORY FIELD IN MHSS INTAKE FILE
+21 ;;^AMHPINTK(;25;VOCATIONAL HISTORY FIELD IN MHSS INTAKE FILE
+22 ;;^AMHPINTK(;26;HOBBIES FIELD IN MHSS INTAKE FILE
+23 ;;^AMHPINTK(;27;STRENGTHS/RESOURCES FIELD IN MHSS INTAKE FILE
+24 ;;^AMHPINTK(;28;INITIAL PLAN FIELD IN MHSS INTAKE FILE
+25 ;;^AMHPINTK(;41;INTAKE DOCUMENTATION/NARRATIVE FIELD IN MHSS INTAKE FILE
+26 ;;^BIP(;1;IMM/SERVE TEXT FIELD IN BI PATIENT FILE
+27 ;;^BWP(;1;NOTES FIELD IN BW PATIENT FILE
+28 ;;^PS(55,;5.2;COMMENTS FIELD IN PHARMACY PATIENT FILE
+29 ;;^SCPT(404.41,;"C";COMMENTS FIELD IN OUTPATIENT PROFILE FILE
+30 ;;^ABSPE(;"TRANS";TRANSMISSION RAW DATA FIELD IN ABSP ELIGIBILITY FILE
+31 ;;^ABSPE(;"RESP";RESPONSE RAW DATA FIELD IN ABSP ELIGIBILITY FILE
+32 ;;$$END
+33 ;;^GMR(126,;"IN";INTAKE FIELD IN GMRY PATIENT I/0 FILE
+34 ;;^GMR(126,;"IV";IV FIELD IN GMRY PATIENT I/O FILE
+35 ;;^GMR(126,;"OUT";OUTPUT FIELD IN GMRY PATIENT I/O FILE
