BILETPR3 ;IHS/CMI/MWR - PRINT PATIENT LETTERS.; MAY 10, 2010
;;8.5;IMMUNIZATION;**10**;MAY 30,2015
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; BUILD ^TMP WP ARRAY FOR PRINTING LETTERS.
;; PATCH 10: If no skin tests on record, display explicitly. HISTORY2+106
;; Display only the most recent three dates of Skin Tests. HISTORY2+152
;
;
;----------
HISTORY2(BILINE,BIHX,BIDFN,BIFORM,BINVAL,BIPDSS) ;EP
;---> Set Immunization History in Listman Letter array, sorted
;---> by Vaccine.
;---> Parameters:
; 1 - BILINE (ret) Last line written into ^TMP array.
; 2 - BIHX (req) Patient's Immunization History (string).
; 3 - BIDFN (req) Patient's IEN in VA PATIENT File #2.
; 4 - BIFORM (opt) 3=List by Vaccine, 4=Vaccine w/Lot#.
; 5 - BINVAL (opt) 0=Include Invalid Doses, 1=Exclude Invalid Doses.
; 6 - BIPDSS (opt) Returned string of Visit IEN's that are
; Problem Doses, according to ImmServe.
;
S:'$G(BIFORM) BIFORM=3
N I,V,X,Y,Z S V="|",Z=""
;
;---> IMMUNIZATIONS
;---> PC DATA
;---> -- ----
;---> 1 = Visit Type: "I"=Immunization, "S"=Skin Test.
;---> 2 = Vaccine Name, Short.
;---> 3 = Vaccine Components. ;v8.0
;---> 4 = IEN, V File Visit.
;---> 5 = Location (or Outside Location) where Imm was given.
;---> 6 = Vaccine Group (Series Type) for grouping of vaccines.
;---> 7 = Vaccine Lot#, Text.
;---> 8 = Skin Test Result.
;---> 9 = Skin Test Reading.
;---> 10 = Skin Test Name.
;---> 11 = Reaction to Immunization, text.
;---> 12 = Date of Visit Fileman format (YYYMMDD).
;---> 13 = Dose Override.
;---> 14 = Vaccine Component CVX Code.
;
S X=" Immunization Date Received Location"
S:BIFORM=4 X=X_" Lot#"
D WRITE(.BILINE,X)
S X=" ------------ ------------- ---------------"
S:BIFORM=4 X=X_" ----------"
D WRITE(.BILINE,X)
;
;---> Loop through "^"-pieces of Imm History, displaying Immunizations.
F I=1:1 S Y=$P(BIHX,U,I) Q:Y="" D
.;
.;---> Quit if this is not an Immunization.
.Q:$P(Y,V)'="I"
.;
.;---> If not the same Vaccine Group, insert a blank line.
.I $P(Y,V,6)'=Z D:I>1 WRITE(.BILINE) S Z=$P(Y,V,6)
.;
.;---> Set display line for this Immunization and Date.
.N BIPDSSA S BIPDSSA=0
.D
..;---> Prepend asterisk if this Dose has a User Override or is
..;---> an ImmServe Problem Dose (flag stored in BIPDSSA).
..I $P(Y,V,13) S X=" *" Q
..I $$PDSS^BIUTL8($P(Y,V,4),$P(Y,V,14),$G(BIPDSS)) S X=" *",BIPDSSA=1 Q
..S X=" "
.;
.S X=X_$P(Y,V,2),X=$$PAD^BIUTL5(X,29)
.S X=X_$$TXDT1^BIUTL5($P(Y,V,12))
.;
.;---> Pad with spaces to line up in columns, add Location.
.S X=$$PAD^BIUTL5(X,45)_$E($P(Y,V,5),1,17)
.;
.;---> If Lot#'s specified, pad with spaces, add Lot#.
.D:BIFORM=4
..S X=$$PAD^BIUTL5(X,64)_$P(Y,V,7)
.D WRITE(.BILINE,X)
.;
.;
.;---> If this is a Dose Override by user, set another line to display it.
.;---> NOT USED FOR NOW.
.;D:$P(Y,V,13)
.;.;---> Do not display if Override Reason is "FORCED VALID" (per Ros Singleton).
.;.Q:$P(Y,V,13)=9
.;.S X=" -"_$$DOVER^BIUTL8($P(Y,V,13))_"-"
.;.D WRITE(.BILINE,X)
.;
.;---> If this is a Problem Dose by ImmServe, set another line to display it.
.;---> NOT USED FOR NOW.
.;D:$G(BIPDSSA)
.;.S X=" -INVALID--SEE IMMSERVE-"
.;.;---> Pad Result with trailing spaces to justify columns.
.;.D WRITE(.BILINE,X)
.;
.;
.;---> If there was a Reaction, set another line to display it.
.D:$P(Y,V,11)]""
..S X=" Reaction: "_$P(Y,V,11)
..;---> Pad Result with trailing spaces to justify columns.
..D WRITE(.BILINE,X)
;
;
;---> SKIN TESTS
;---> PC DATA
;---> -- ----
;---> 1 = Visit Type: "I"=Immunization, "S"=Skin Test.
;---> 4 = V Skin Test File IEN.
;---> 5 = Location (or Outside Location) where Imm was given.
;---> 8 = Skin Test Result.
;---> 9 = Skin Test Reading.
;---> 10 = Skin Test Name.
;---> 12 = Date of Visit Fileman format (YYYMMDD).
;
;---> Do not print Skin Test headers if patient has no Skin Tests.
;
;********** PATCH 10, v8.5, MAY 30,2015, IHS/CMI/MWR
;---> If no skin tests on record, display that explicitly.
;I $G(BIDFN) Q:'$D(^AUPNVSK("AC",BIDFN))
Q:'$G(BIDFN)
I '$D(^AUPNVSK("AC",BIDFN)) D Q
.D WRITE(.BILINE)
.S X=" Skin Tests/PPD: None on record"
.D WRITE(.BILINE,X)
;
;---> Add "Recent".
;D WRITE(.BILINE),WRITE(.BILINE)
D WRITE(.BILINE),WRITE(.BILINE," Recent")
;**********
S X=" Skin Tests Date Received Location"
S X=X_" Result"
D WRITE(.BILINE,X)
S X=" ------------ ------------- ---------------"
S X=X_" ---------"
D WRITE(.BILINE,X)
;
;---> Loop through "^"-pieces of Imm History, displaying Skin Tests.
;
;
;Display only the most recent 3.
;
N BIZTEMP
;
F I=1:1 S Y=$P(BIHX,U,I) Q:Y="" D
.;
.;---> Quit if this is not a Skin Test.
.Q:$P(Y,V)'="S"
.;
.;---> Set display line for this Skin Test Name and Date.
.S X=" "_$P(Y,V,10),X=$$PAD^BIUTL5(X,22)
.S X=X_$$TXDT1^BIUTL5($P(Y,V,12))
.;
.;---> Pad with spaces to line up in columns, add Location.
.S X=$$PAD^BIUTL5(X,40)_$E($P(Y,V,5),1,15)
.;
.;---> Pad with spaces to line up in columns, add Result.
.S X=$$PAD^BIUTL5(X,60)
.D
..I $P(Y,V,8)]"" S X=X_$P(Y,V,8) Q
..I $P(Y,V,9) S X=X_$P(Y,V,9)_" mm" Q
..S X=X_"Not recorded"
..;
.;********** PATCH 10, v8.5, MAY 30,2015, IHS/CMI/MWR
.;---> Display only the most recent three dates of Skin Tests.
.S BIZTEMP($P(Y,V,12),$P(Y,V,10))=X
.;D WRITE(.BILINE,X)
;
N N S N=9999999
F I=1:1:4 S N=+$O(BIZTEMP(N),-1) Q:'N
F S N=$O(BIZTEMP(N)) Q:'N D
.N M S M=""
.F S M=$O(BIZTEMP(N,M)) Q:(M="") D
..D WRITE(.BILINE,BIZTEMP(N,M))
;**********
Q
;
;
;----------
WRITE(BILINE,BIVAL,BIGBL) ;EP
;---> Write a line to the ^TMP global for WP or Listman.
;---> NOTE: DUPLICATE CODE IN ^BILETPR3 FOR SPEED.
;---> Parameters:
; 1 - BILINE (ret) Last line# in the WP ^TMP global.
; 2 - BIVAL (opt) Value/text of line (Null=blank line).
; 3 - BIGBL (opt) ^TMP global node to write to (def="BILET").
;
Q:'$D(BILINE)
S:$G(BIGBL)="" BIGBL="BILET"
D WL^BIW(.BILINE,BIGBL,$G(BIVAL))
Q
BILETPR3 ;IHS/CMI/MWR - PRINT PATIENT LETTERS.; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;**10**;MAY 30,2015
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; BUILD ^TMP WP ARRAY FOR PRINTING LETTERS.
+4 ;; PATCH 10: If no skin tests on record, display explicitly. HISTORY2+106
+5 ;; Display only the most recent three dates of Skin Tests. HISTORY2+152
+6 ;
+7 ;
+8 ;----------
HISTORY2(BILINE,BIHX,BIDFN,BIFORM,BINVAL,BIPDSS) ;EP
+1 ;---> Set Immunization History in Listman Letter array, sorted
+2 ;---> by Vaccine.
+3 ;---> Parameters:
+4 ; 1 - BILINE (ret) Last line written into ^TMP array.
+5 ; 2 - BIHX (req) Patient's Immunization History (string).
+6 ; 3 - BIDFN (req) Patient's IEN in VA PATIENT File #2.
+7 ; 4 - BIFORM (opt) 3=List by Vaccine, 4=Vaccine w/Lot#.
+8 ; 5 - BINVAL (opt) 0=Include Invalid Doses, 1=Exclude Invalid Doses.
+9 ; 6 - BIPDSS (opt) Returned string of Visit IEN's that are
+10 ; Problem Doses, according to ImmServe.
+11 ;
+12 IF '$GET(BIFORM)
SET BIFORM=3
+13 NEW I,V,X,Y,Z
SET V="|"
SET Z=""
+14 ;
+15 ;---> IMMUNIZATIONS
+16 ;---> PC DATA
+17 ;---> -- ----
+18 ;---> 1 = Visit Type: "I"=Immunization, "S"=Skin Test.
+19 ;---> 2 = Vaccine Name, Short.
+20 ;---> 3 = Vaccine Components. ;v8.0
+21 ;---> 4 = IEN, V File Visit.
+22 ;---> 5 = Location (or Outside Location) where Imm was given.
+23 ;---> 6 = Vaccine Group (Series Type) for grouping of vaccines.
+24 ;---> 7 = Vaccine Lot#, Text.
+25 ;---> 8 = Skin Test Result.
+26 ;---> 9 = Skin Test Reading.
+27 ;---> 10 = Skin Test Name.
+28 ;---> 11 = Reaction to Immunization, text.
+29 ;---> 12 = Date of Visit Fileman format (YYYMMDD).
+30 ;---> 13 = Dose Override.
+31 ;---> 14 = Vaccine Component CVX Code.
+32 ;
+33 SET X=" Immunization Date Received Location"
+34 IF BIFORM=4
SET X=X_" Lot#"
+35 DO WRITE(.BILINE,X)
+36 SET X=" ------------ ------------- ---------------"
+37 IF BIFORM=4
SET X=X_" ----------"
+38 DO WRITE(.BILINE,X)
+39 ;
+40 ;---> Loop through "^"-pieces of Imm History, displaying Immunizations.
+41 FOR I=1:1
SET Y=$PIECE(BIHX,U,I)
IF Y=""
QUIT
Begin DoDot:1
+42 ;
+43 ;---> Quit if this is not an Immunization.
+44 IF $PIECE(Y,V)'="I"
QUIT
+45 ;
+46 ;---> If not the same Vaccine Group, insert a blank line.
+47 IF $PIECE(Y,V,6)'=Z
IF I>1
DO WRITE(.BILINE)
SET Z=$PIECE(Y,V,6)
+48 ;
+49 ;---> Set display line for this Immunization and Date.
+50 NEW BIPDSSA
SET BIPDSSA=0
+51 Begin DoDot:2
+52 ;---> Prepend asterisk if this Dose has a User Override or is
+53 ;---> an ImmServe Problem Dose (flag stored in BIPDSSA).
+54 IF $PIECE(Y,V,13)
SET X=" *"
QUIT
+55 IF $$PDSS^BIUTL8($PIECE(Y,V,4),$PIECE(Y,V,14),$GET(BIPDSS))
SET X=" *"
SET BIPDSSA=1
QUIT
+56 SET X=" "
End DoDot:2
+57 ;
+58 SET X=X_$PIECE(Y,V,2)
SET X=$$PAD^BIUTL5(X,29)
+59 SET X=X_$$TXDT1^BIUTL5($PIECE(Y,V,12))
+60 ;
+61 ;---> Pad with spaces to line up in columns, add Location.
+62 SET X=$$PAD^BIUTL5(X,45)_$EXTRACT($PIECE(Y,V,5),1,17)
+63 ;
+64 ;---> If Lot#'s specified, pad with spaces, add Lot#.
+65 IF BIFORM=4
Begin DoDot:2
+66 SET X=$$PAD^BIUTL5(X,64)_$PIECE(Y,V,7)
End DoDot:2
+67 DO WRITE(.BILINE,X)
+68 ;
+69 ;
+70 ;---> If this is a Dose Override by user, set another line to display it.
+71 ;---> NOT USED FOR NOW.
+72 ;D:$P(Y,V,13)
+73 ;.;---> Do not display if Override Reason is "FORCED VALID" (per Ros Singleton).
+74 ;.Q:$P(Y,V,13)=9
+75 ;.S X=" -"_$$DOVER^BIUTL8($P(Y,V,13))_"-"
+76 ;.D WRITE(.BILINE,X)
+77 ;
+78 ;---> If this is a Problem Dose by ImmServe, set another line to display it.
+79 ;---> NOT USED FOR NOW.
+80 ;D:$G(BIPDSSA)
+81 ;.S X=" -INVALID--SEE IMMSERVE-"
+82 ;.;---> Pad Result with trailing spaces to justify columns.
+83 ;.D WRITE(.BILINE,X)
+84 ;
+85 ;
+86 ;---> If there was a Reaction, set another line to display it.
+87 IF $PIECE(Y,V,11)]""
Begin DoDot:2
+88 SET X=" Reaction: "_$PIECE(Y,V,11)
+89 ;---> Pad Result with trailing spaces to justify columns.
+90 DO WRITE(.BILINE,X)
End DoDot:2
End DoDot:1
+91 ;
+92 ;
+93 ;---> SKIN TESTS
+94 ;---> PC DATA
+95 ;---> -- ----
+96 ;---> 1 = Visit Type: "I"=Immunization, "S"=Skin Test.
+97 ;---> 4 = V Skin Test File IEN.
+98 ;---> 5 = Location (or Outside Location) where Imm was given.
+99 ;---> 8 = Skin Test Result.
+100 ;---> 9 = Skin Test Reading.
+101 ;---> 10 = Skin Test Name.
+102 ;---> 12 = Date of Visit Fileman format (YYYMMDD).
+103 ;
+104 ;---> Do not print Skin Test headers if patient has no Skin Tests.
+105 ;
+106 ;********** PATCH 10, v8.5, MAY 30,2015, IHS/CMI/MWR
+107 ;---> If no skin tests on record, display that explicitly.
+108 ;I $G(BIDFN) Q:'$D(^AUPNVSK("AC",BIDFN))
+109 IF '$GET(BIDFN)
QUIT
+110 IF '$DATA(^AUPNVSK("AC",BIDFN))
Begin DoDot:1
+111 DO WRITE(.BILINE)
+112 SET X=" Skin Tests/PPD: None on record"
+113 DO WRITE(.BILINE,X)
End DoDot:1
QUIT
+114 ;
+115 ;---> Add "Recent".
+116 ;D WRITE(.BILINE),WRITE(.BILINE)
+117 DO WRITE(.BILINE)
DO WRITE(.BILINE," Recent")
+118 ;**********
+119 SET X=" Skin Tests Date Received Location"
+120 SET X=X_" Result"
+121 DO WRITE(.BILINE,X)
+122 SET X=" ------------ ------------- ---------------"
+123 SET X=X_" ---------"
+124 DO WRITE(.BILINE,X)
+125 ;
+126 ;---> Loop through "^"-pieces of Imm History, displaying Skin Tests.
+127 ;
+128 ;
+129 ;Display only the most recent 3.
+130 ;
+131 NEW BIZTEMP
+132 ;
+133 FOR I=1:1
SET Y=$PIECE(BIHX,U,I)
IF Y=""
QUIT
Begin DoDot:1
+134 ;
+135 ;---> Quit if this is not a Skin Test.
+136 IF $PIECE(Y,V)'="S"
QUIT
+137 ;
+138 ;---> Set display line for this Skin Test Name and Date.
+139 SET X=" "_$PIECE(Y,V,10)
SET X=$$PAD^BIUTL5(X,22)
+140 SET X=X_$$TXDT1^BIUTL5($PIECE(Y,V,12))
+141 ;
+142 ;---> Pad with spaces to line up in columns, add Location.
+143 SET X=$$PAD^BIUTL5(X,40)_$EXTRACT($PIECE(Y,V,5),1,15)
+144 ;
+145 ;---> Pad with spaces to line up in columns, add Result.
+146 SET X=$$PAD^BIUTL5(X,60)
+147 Begin DoDot:2
+148 IF $PIECE(Y,V,8)]""
SET X=X_$PIECE(Y,V,8)
QUIT
+149 IF $PIECE(Y,V,9)
SET X=X_$PIECE(Y,V,9)_" mm"
QUIT
+150 SET X=X_"Not recorded"
+151 ;
End DoDot:2
+152 ;********** PATCH 10, v8.5, MAY 30,2015, IHS/CMI/MWR
+153 ;---> Display only the most recent three dates of Skin Tests.
+154 SET BIZTEMP($PIECE(Y,V,12),$PIECE(Y,V,10))=X
+155 ;D WRITE(.BILINE,X)
End DoDot:1
+156 ;
+157 NEW N
SET N=9999999
+158 FOR I=1:1:4
SET N=+$ORDER(BIZTEMP(N),-1)
IF 'N
QUIT
+159 FOR
SET N=$ORDER(BIZTEMP(N))
IF 'N
QUIT
Begin DoDot:1
+160 NEW M
SET M=""
+161 FOR
SET M=$ORDER(BIZTEMP(N,M))
IF (M="")
QUIT
Begin DoDot:2
+162 DO WRITE(.BILINE,BIZTEMP(N,M))
End DoDot:2
End DoDot:1
+163 ;**********
+164 QUIT
+165 ;
+166 ;
+167 ;----------
WRITE(BILINE,BIVAL,BIGBL) ;EP
+1 ;---> Write a line to the ^TMP global for WP or Listman.
+2 ;---> NOTE: DUPLICATE CODE IN ^BILETPR3 FOR SPEED.
+3 ;---> Parameters:
+4 ; 1 - BILINE (ret) Last line# in the WP ^TMP global.
+5 ; 2 - BIVAL (opt) Value/text of line (Null=blank line).
+6 ; 3 - BIGBL (opt) ^TMP global node to write to (def="BILET").
+7 ;
+8 IF '$DATA(BILINE)
QUIT
+9 IF $GET(BIGBL)=""
SET BIGBL="BILET"
+10 DO WL^BIW(.BILINE,BIGBL,$GET(BIVAL))
+11 QUIT
