- 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