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

BILETPR3.m

Go to the documentation of this file.
  1. BILETPR3 ;IHS/CMI/MWR - PRINT PATIENT LETTERS.; MAY 10, 2010
  1. ;;8.5;IMMUNIZATION;**10**;MAY 30,2015
  1. ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
  1. ;; BUILD ^TMP WP ARRAY FOR PRINTING LETTERS.
  1. ;; PATCH 10: If no skin tests on record, display explicitly. HISTORY2+106
  1. ;; Display only the most recent three dates of Skin Tests. HISTORY2+152
  1. ;
  1. ;
  1. ;----------
  1. HISTORY2(BILINE,BIHX,BIDFN,BIFORM,BINVAL,BIPDSS) ;EP
  1. ;---> Set Immunization History in Listman Letter array, sorted
  1. ;---> by Vaccine.
  1. ;---> Parameters:
  1. ; 1 - BILINE (ret) Last line written into ^TMP array.
  1. ; 2 - BIHX (req) Patient's Immunization History (string).
  1. ; 3 - BIDFN (req) Patient's IEN in VA PATIENT File #2.
  1. ; 4 - BIFORM (opt) 3=List by Vaccine, 4=Vaccine w/Lot#.
  1. ; 5 - BINVAL (opt) 0=Include Invalid Doses, 1=Exclude Invalid Doses.
  1. ; 6 - BIPDSS (opt) Returned string of Visit IEN's that are
  1. ; Problem Doses, according to ImmServe.
  1. ;
  1. S:'$G(BIFORM) BIFORM=3
  1. N I,V,X,Y,Z S V="|",Z=""
  1. ;
  1. ;---> IMMUNIZATIONS
  1. ;---> PC DATA
  1. ;---> -- ----
  1. ;---> 1 = Visit Type: "I"=Immunization, "S"=Skin Test.
  1. ;---> 2 = Vaccine Name, Short.
  1. ;---> 3 = Vaccine Components. ;v8.0
  1. ;---> 4 = IEN, V File Visit.
  1. ;---> 5 = Location (or Outside Location) where Imm was given.
  1. ;---> 6 = Vaccine Group (Series Type) for grouping of vaccines.
  1. ;---> 7 = Vaccine Lot#, Text.
  1. ;---> 8 = Skin Test Result.
  1. ;---> 9 = Skin Test Reading.
  1. ;---> 10 = Skin Test Name.
  1. ;---> 11 = Reaction to Immunization, text.
  1. ;---> 12 = Date of Visit Fileman format (YYYMMDD).
  1. ;---> 13 = Dose Override.
  1. ;---> 14 = Vaccine Component CVX Code.
  1. ;
  1. S X=" Immunization Date Received Location"
  1. S:BIFORM=4 X=X_" Lot#"
  1. D WRITE(.BILINE,X)
  1. S X=" ------------ ------------- ---------------"
  1. S:BIFORM=4 X=X_" ----------"
  1. D WRITE(.BILINE,X)
  1. ;
  1. ;---> Loop through "^"-pieces of Imm History, displaying Immunizations.
  1. F I=1:1 S Y=$P(BIHX,U,I) Q:Y="" D
  1. .;
  1. .;---> Quit if this is not an Immunization.
  1. .Q:$P(Y,V)'="I"
  1. .;
  1. .;---> If not the same Vaccine Group, insert a blank line.
  1. .I $P(Y,V,6)'=Z D:I>1 WRITE(.BILINE) S Z=$P(Y,V,6)
  1. .;
  1. .;---> Set display line for this Immunization and Date.
  1. .N BIPDSSA S BIPDSSA=0
  1. .D
  1. ..;---> Prepend asterisk if this Dose has a User Override or is
  1. ..;---> an ImmServe Problem Dose (flag stored in BIPDSSA).
  1. ..I $P(Y,V,13) S X=" *" Q
  1. ..I $$PDSS^BIUTL8($P(Y,V,4),$P(Y,V,14),$G(BIPDSS)) S X=" *",BIPDSSA=1 Q
  1. ..S X=" "
  1. .;
  1. .S X=X_$P(Y,V,2),X=$$PAD^BIUTL5(X,29)
  1. .S X=X_$$TXDT1^BIUTL5($P(Y,V,12))
  1. .;
  1. .;---> Pad with spaces to line up in columns, add Location.
  1. .S X=$$PAD^BIUTL5(X,45)_$E($P(Y,V,5),1,17)
  1. .;
  1. .;---> If Lot#'s specified, pad with spaces, add Lot#.
  1. .D:BIFORM=4
  1. ..S X=$$PAD^BIUTL5(X,64)_$P(Y,V,7)
  1. .D WRITE(.BILINE,X)
  1. .;
  1. .;
  1. .;---> If this is a Dose Override by user, set another line to display it.
  1. .;---> NOT USED FOR NOW.
  1. .;D:$P(Y,V,13)
  1. .;.;---> Do not display if Override Reason is "FORCED VALID" (per Ros Singleton).
  1. .;.Q:$P(Y,V,13)=9
  1. .;.S X=" -"_$$DOVER^BIUTL8($P(Y,V,13))_"-"
  1. .;.D WRITE(.BILINE,X)
  1. .;
  1. .;---> If this is a Problem Dose by ImmServe, set another line to display it.
  1. .;---> NOT USED FOR NOW.
  1. .;D:$G(BIPDSSA)
  1. .;.S X=" -INVALID--SEE IMMSERVE-"
  1. .;.;---> Pad Result with trailing spaces to justify columns.
  1. .;.D WRITE(.BILINE,X)
  1. .;
  1. .;
  1. .;---> If there was a Reaction, set another line to display it.
  1. .D:$P(Y,V,11)]""
  1. ..S X=" Reaction: "_$P(Y,V,11)
  1. ..;---> Pad Result with trailing spaces to justify columns.
  1. ..D WRITE(.BILINE,X)
  1. ;
  1. ;
  1. ;---> SKIN TESTS
  1. ;---> PC DATA
  1. ;---> -- ----
  1. ;---> 1 = Visit Type: "I"=Immunization, "S"=Skin Test.
  1. ;---> 4 = V Skin Test File IEN.
  1. ;---> 5 = Location (or Outside Location) where Imm was given.
  1. ;---> 8 = Skin Test Result.
  1. ;---> 9 = Skin Test Reading.
  1. ;---> 10 = Skin Test Name.
  1. ;---> 12 = Date of Visit Fileman format (YYYMMDD).
  1. ;
  1. ;---> Do not print Skin Test headers if patient has no Skin Tests.
  1. ;
  1. ;********** PATCH 10, v8.5, MAY 30,2015, IHS/CMI/MWR
  1. ;---> If no skin tests on record, display that explicitly.
  1. ;I $G(BIDFN) Q:'$D(^AUPNVSK("AC",BIDFN))
  1. Q:'$G(BIDFN)
  1. I '$D(^AUPNVSK("AC",BIDFN)) D Q
  1. .D WRITE(.BILINE)
  1. .S X=" Skin Tests/PPD: None on record"
  1. .D WRITE(.BILINE,X)
  1. ;
  1. ;---> Add "Recent".
  1. ;D WRITE(.BILINE),WRITE(.BILINE)
  1. D WRITE(.BILINE),WRITE(.BILINE," Recent")
  1. ;**********
  1. S X=" Skin Tests Date Received Location"
  1. S X=X_" Result"
  1. D WRITE(.BILINE,X)
  1. S X=" ------------ ------------- ---------------"
  1. S X=X_" ---------"
  1. D WRITE(.BILINE,X)
  1. ;
  1. ;---> Loop through "^"-pieces of Imm History, displaying Skin Tests.
  1. ;
  1. ;
  1. ;Display only the most recent 3.
  1. ;
  1. N BIZTEMP
  1. ;
  1. F I=1:1 S Y=$P(BIHX,U,I) Q:Y="" D
  1. .;
  1. .;---> Quit if this is not a Skin Test.
  1. .Q:$P(Y,V)'="S"
  1. .;
  1. .;---> Set display line for this Skin Test Name and Date.
  1. .S X=" "_$P(Y,V,10),X=$$PAD^BIUTL5(X,22)
  1. .S X=X_$$TXDT1^BIUTL5($P(Y,V,12))
  1. .;
  1. .;---> Pad with spaces to line up in columns, add Location.
  1. .S X=$$PAD^BIUTL5(X,40)_$E($P(Y,V,5),1,15)
  1. .;
  1. .;---> Pad with spaces to line up in columns, add Result.
  1. .S X=$$PAD^BIUTL5(X,60)
  1. .D
  1. ..I $P(Y,V,8)]"" S X=X_$P(Y,V,8) Q
  1. ..I $P(Y,V,9) S X=X_$P(Y,V,9)_" mm" Q
  1. ..S X=X_"Not recorded"
  1. ..;
  1. .;********** PATCH 10, v8.5, MAY 30,2015, IHS/CMI/MWR
  1. .;---> Display only the most recent three dates of Skin Tests.
  1. .S BIZTEMP($P(Y,V,12),$P(Y,V,10))=X
  1. .;D WRITE(.BILINE,X)
  1. ;
  1. N N S N=9999999
  1. F I=1:1:4 S N=+$O(BIZTEMP(N),-1) Q:'N
  1. F S N=$O(BIZTEMP(N)) Q:'N D
  1. .N M S M=""
  1. .F S M=$O(BIZTEMP(N,M)) Q:(M="") D
  1. ..D WRITE(.BILINE,BIZTEMP(N,M))
  1. ;**********
  1. Q
  1. ;
  1. ;
  1. ;----------
  1. WRITE(BILINE,BIVAL,BIGBL) ;EP
  1. ;---> Write a line to the ^TMP global for WP or Listman.
  1. ;---> NOTE: DUPLICATE CODE IN ^BILETPR3 FOR SPEED.
  1. ;---> Parameters:
  1. ; 1 - BILINE (ret) Last line# in the WP ^TMP global.
  1. ; 2 - BIVAL (opt) Value/text of line (Null=blank line).
  1. ; 3 - BIGBL (opt) ^TMP global node to write to (def="BILET").
  1. ;
  1. Q:'$D(BILINE)
  1. S:$G(BIGBL)="" BIGBL="BILET"
  1. D WL^BIW(.BILINE,BIGBL,$G(BIVAL))
  1. Q