- BIDUVLS2 ;IHS/CMI/MWR - VIEW DUE LIST VIEW.; MAY 10, 2010
- ;;8.5;IMMUNIZATION;;SEP 01,2011
- ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
- ;; LIST TEMPLATE CODE FOR VIEWING PATIENTS DUE, SET LINES FOR
- ;; INDIVIDUAL PATIENTS.
- ;
- ;
- ;----------
- PATIENT(BILINE,BIDFN,BINFO,BIDASH,BIMMRF,BIMMLF) ;EP
- ;---> Set line in Listman display global.
- ;---> Parameters:
- ; 1 - BILINE (req) Line Number in display area.
- ; 2 - BIDFN (req) Patient DFN.
- ; 3 - BINFO (req) Array of Additional Info elements.
- ; 4 - BIDASH (opt) 1=Omit Dash line between records; 0=include it.
- ; 5 - BIMMRF (opt) Imms Received Filter array (subscript=CVX's included).
- ; 6 - BIMMLF (opt) Lot Number Filter array (subscript=lot number text).
- ;
- Q:$G(BILINE)=""
- N BIPLIN,BIPLIN1,X
- ;
- ;---> Patient demographic line.
- S X=" "_$E($$NAME^BIUTL1(BIDFN),1,19)
- S X=$$PAD^BIUTL5(X,22)_$$PAD^BIUTL5($$HRCN^BIUTL1(BIDFN,DUZ(2)),8)
- ;S X=X_" "_$$DOBF^BIUTL1(BIDFN,,,1)_" "_$$SEX^BIUTL1(BIDFN) vvv83
- S X=X_" "_$$DOBF^BIUTL1(BIDFN,$G(BIFDT),,1)
- S X=$$PAD^BIUTL5(X,54)_$$SEX^BIUTL1(BIDFN)
- S X=$$PAD^BIUTL5(X,58)_$E($$CURCOM^BIUTL11(BIDFN,1),1,21)
- D:'$G(BIDASH) WRITE(.BILINE)
- D WRITE(.BILINE,X) K X
- ;---> Preserve line number of Patient demographic line, for record
- ;---> line count and for address and phone lines below.
- S BIPLIN=BILINE-1,BIPLIN1=BILINE+1
- ;
- ;---> Next section: Write specifed Additional Information in BINFO.
- ;
- ;--> Check if BINFO("ALL") exists. If so, set BIALL=1 and display all Info.
- N BIALL S BIALL=0
- S:$D(BINFO("ALL")) BIALL=1
- ;
- ;---> First, build Data String, BINFODS, of Add Info elements (2nd piece of
- ;---> BI TABLE ADD INFO File #9002084.82).
- N BINFODS
- D
- .N N S N=0
- .F S N=$O(BINFO(N)) Q:'N D
- ..S BINFODS=$G(BINFODS)_$P($G(^BIADDIN(N,0)),U,2)_"^"
- .S:'$G(BINFODS) BINFODS=0
- ;
- ;---> Forecast.
- D:((BINFODS[15)!BIALL) WRITE(.BILINE),FORECAST(.BILINE,BIDFN,$G(BIFDT))
- ;
- ;---> Address.
- D:((BINFODS[12)!BIALL)
- .N X S X="Address..: "_$E($$STREET^BIUTL1(BIDFN),1,38)
- .S BIPLIN1=BIPLIN1+1
- .D APPEND(BIPLIN1,X,.BILINE)
- .S X=" "_$$CTYSTZ^BIUTL1(BIDFN),BIPLIN1=BIPLIN1+1
- .D APPEND(BIPLIN1,X,.BILINE)
- ;
- ;---> Phone Number.
- D:((BINFODS[11)!BIALL)
- .N X S X="Phone....: "_$$HPHONE^BIUTL1(BIDFN),BIPLIN1=BIPLIN1+1
- .D APPEND(BIPLIN1,X,.BILINE)
- ;
- ;---> Parent/Guardian.
- D:((BINFODS[17)!BIALL)
- .N X S X="Parent...: "_$$PARENT^BIUTL1(BIDFN),BIPLIN1=BIPLIN1+1
- .D APPEND(BIPLIN1,X,.BILINE)
- ;
- ;---> Case Manager.
- D:((BINFODS[18)!BIALL)
- .N X S X="Case Mgr.: "_$$CMGR^BIUTL1(BIDFN,1,1),BIPLIN1=BIPLIN1+1
- .D APPEND(BIPLIN1,X,.BILINE)
- ;
- ;---> Reason Inactivated.
- D:((BINFODS[19)!BIALL)
- .Q:('$$INACT^BIUTL1(BIDFN))
- .N X S X="Inactive.: "_$$INACTRE^BIUTL1(BIDFN),BIPLIN1=BIPLIN1+1
- .D APPEND(BIPLIN1,X,.BILINE)
- ;
- ;---> Immunization History.
- I (BINFODS[13)!(BINFODS[14)!(BINFODS[20)!(BINFODS[22)!(BINFODS[25)!BIALL D
- .;---> Write either History or History w/Lot#'s, VFC, with or without Skin Tests.
- .N X D
- ..I (BINFODS[14)&(BINFODS'[25) S X=2 Q
- ..I (BINFODS'[14)&(BINFODS[25) S X=5 Q
- ..I (BINFODS[14)&(BINFODS[25) S X=7 Q
- ..S X=1
- .;
- .;---> Include location where shot was given.
- .N Y S Y=$S(BINFODS[22:1,1:0)
- .N Z S Z=1
- .D:(BINFODS[20)
- ..I ((BINFODS'[13)&(BINFODS'[14)&(BINFODS'[25)) S Z=2 Q
- ..S Z=0
- .D WRITE(.BILINE),WRITE(.BILINE," History:")
- .D HISTORY1^BILETPR1(.BILINE,BIDFN,X,,"BIDULV",,,Z,Y,.BIMMRF,.BIMMLF)
- ;
- ;
- ;---> Refusals.
- D:((BINFODS[23)!BIALL)
- .N A,X1,X2,X3 S (X1,X2,X3)=""
- .D CONTRA^BIUTL11(BIDFN,.A,1,1)
- .Q:('$D(A))
- .D WRITE(.BILINE)
- .S X1=" Refusals: "
- .N N,M S N=0,M=0
- .F S N=$O(A(N)) Q:'N D
- ..N X S M=M+1
- ..S X=$$VNAME^BIUTL2($$HL7TX^BIUTL2(N))_" ("_$$SLDT2^BIUTL5($P(A(N),U,2),1)_")"
- ..S:"235689"[M X=", "_X
- ..I M<4 S X1=X1_X Q
- ..I M<7 S:M=4 X2=" ",X1=X1_"," S X2=X2_X Q
- ..S:M=7 X3=" ",X2=X2_"," S X3=X3_X Q
- .I X1]"" D WRITE(.BILINE,X1)
- .I X2]"" D WRITE(.BILINE,X2)
- .I X3]"" D WRITE(.BILINE,X3)
- ;
- ;---> Next Appointment.
- D:((BINFODS[21)!BIALL)
- .;---> Write either Patient's Next Appointment if there is one.
- .N X S X=$$NEXTAPPT^BIUTL11(BIDFN)
- .D:X]""
- ..S X=" Next Appointment: "_$E(X,1,57)
- ..D WRITE(.BILINE),WRITE(.BILINE,X)
- ;
- ;---> Directions to House.
- D:((BINFODS[16)!BIALL)
- .Q:'$O(^AUPNPAT(BIDFN,12,0))
- .D WRITE(.BILINE)
- .N X S X=" Directions to the home of "_$$NAME^BIUTL1(BIDFN,1)_":"
- .D WRITE(.BILINE,X)
- .N N S N=0
- .F S N=$O(^AUPNPAT(BIDFN,12,N)) Q:'N D
- ..S X=$G(^AUPNPAT(BIDFN,12,N,0))
- ..D WRITE(.BILINE," "_X)
- ;
- D:'$G(BIDASH) WRITE(.BILINE," "_$$SP^BIUTL5(73,"-"))
- ;---> Mark the top line of this record with the total lines in it.
- D MARK^BIW(BIPLIN,BILINE-BIPLIN,"BIDULV")
- Q
- ;
- ;
- ;----------
- FORECAST(BILINE,BIDFN,BIFDT) ;EP
- ;---> Retrieve and store Imm Forecast in WP ^TMP global.
- ;---> Parameters:
- ; 2 - BILINE (ret) Last line written into ^TMP array.
- ; 3 - BIDFN (req) Patient's IEN in VA PATIENT File #2.
- ; 4 - BIFDT (opt) Forecast Date.
- ;
- Q:'$D(BILINE) Q:'$G(BIDFN)
- ;
- ;---> If Patient is deceased, display date instead of forecast.
- N X S X=$$DECEASED^BIUTL1(BIDFN,1)
- I X D WRITE(.BILINE),WRITE(.BILINE," DECEASED: "_$$TXDT^BIUTL5(X)) Q
- ;
- ;---> If Forecast Date not provided, set it equal to today.
- S:'$G(BIFDT) BIFDT=DT
- ;
- ;---> RPC to gather Immunization History.
- ; BIRETVAL - Return value of valid data from RPC.
- ; BIRETERR - Return value (text string) of error from RPC.
- ;
- N BIRETVAL,BIRETERR S BIRETVAL=""
- ;---> Next line: 4th param=1 to not call Immserve because forecast
- ;---> just got updated in retrieving patients: +225^BIDUR.
- D IMMFORC^BIRPC(.BIRETVAL,BIDFN,BIFDT,1)
- ;
- ;---> If BIRETERR has a value, store it and quit.
- S BIRETERR=$P(BIRETVAL,BI31,2)
- I BIRETERR]"" D Q
- .D WRITE(.BILINE),WRITE(.BILINE," "_BIRETERR),WRITE(.BILINE)
- ;
- ;---> Set BIFDTORC=to the Immunization Forecast for this patient.
- N BIFDTORC,I,V S V="|",BIFDTORC=$P(BIRETVAL,BI31,1)
- ;
- ;---> Loop through "^"-pieces of Imm Forecast, getting data.
- F I=1:1 S Y=$P(BIFDTORC,U,I) Q:Y="" D
- .N X,Z S X=$S(I=1:" Needs: ",1:" ")
- .;---> If the forecast for this vaccine contains an error,
- .;---> write Vaccine Group Name Error, such as, $P("DTP ERROR:",":").
- .S Z=$P(Y,V),Z=X_$P(Z,":")
- .D WRITE(.BILINE,Z)
- Q
- ;
- ;
- ;----------
- WRITE(BILINE,BIVAL) ;EP
- ;---> Write a line to the ^TMP global for WP or Listman.
- ;---> Parameters:
- ; 1 - BILINE (ret) Last line# in the WP ^TMP global.
- ; 2 - BIVAL (opt) Value/text of line (Null=blank line).
- ;
- Q:'$D(BILINE)
- S:$G(BIVAL)="" BIVAL=" "
- S BILINE=BILINE+1,^TMP("BIDULV",$J,BILINE,0)=BIVAL
- Q
- ;
- ;
- ;----------
- APPEND(BIPLIN1,BIVAL,BILINE) ;EP
- ;---> Append BIVAL to existing line or create new line.
- ;---> Parameters:
- ; 1 - BIPLIN1 (ret) Line down from demog line to be added to.
- ; 2 - BIVAL (opt) Value/text of line (Null=blank line).
- ; 3 - BILINE (ret) Last line# in the WP ^TMP global.
- ;
- Q:'$D(BILINE)
- Q:$G(BIVAL)=""
- ;
- ;---> If line already exists, append to it.
- N X
- I $D(^TMP("BIDULV",$J,BIPLIN1,0)) S X=^(0) D Q
- .S X=$$PAD^BIUTL5(X,32)_BIVAL
- .S ^TMP("BIDULV",$J,BIPLIN1,0)=X
- ;
- ;---> If line doesn't exist, create it.
- D WRITE(.BILINE,$$SP^BIUTL5(32)_BIVAL)
- Q
- BIDUVLS2 ;IHS/CMI/MWR - VIEW DUE LIST VIEW.; MAY 10, 2010
- +1 ;;8.5;IMMUNIZATION;;SEP 01,2011
- +2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
- +3 ;; LIST TEMPLATE CODE FOR VIEWING PATIENTS DUE, SET LINES FOR
- +4 ;; INDIVIDUAL PATIENTS.
- +5 ;
- +6 ;
- +7 ;----------
- PATIENT(BILINE,BIDFN,BINFO,BIDASH,BIMMRF,BIMMLF) ;EP
- +1 ;---> Set line in Listman display global.
- +2 ;---> Parameters:
- +3 ; 1 - BILINE (req) Line Number in display area.
- +4 ; 2 - BIDFN (req) Patient DFN.
- +5 ; 3 - BINFO (req) Array of Additional Info elements.
- +6 ; 4 - BIDASH (opt) 1=Omit Dash line between records; 0=include it.
- +7 ; 5 - BIMMRF (opt) Imms Received Filter array (subscript=CVX's included).
- +8 ; 6 - BIMMLF (opt) Lot Number Filter array (subscript=lot number text).
- +9 ;
- +10 IF $GET(BILINE)=""
- QUIT
- +11 NEW BIPLIN,BIPLIN1,X
- +12 ;
- +13 ;---> Patient demographic line.
- +14 SET X=" "_$EXTRACT($$NAME^BIUTL1(BIDFN),1,19)
- +15 SET X=$$PAD^BIUTL5(X,22)_$$PAD^BIUTL5($$HRCN^BIUTL1(BIDFN,DUZ(2)),8)
- +16 ;S X=X_" "_$$DOBF^BIUTL1(BIDFN,,,1)_" "_$$SEX^BIUTL1(BIDFN) vvv83
- +17 SET X=X_" "_$$DOBF^BIUTL1(BIDFN,$GET(BIFDT),,1)
- +18 SET X=$$PAD^BIUTL5(X,54)_$$SEX^BIUTL1(BIDFN)
- +19 SET X=$$PAD^BIUTL5(X,58)_$EXTRACT($$CURCOM^BIUTL11(BIDFN,1),1,21)
- +20 IF '$GET(BIDASH)
- DO WRITE(.BILINE)
- +21 DO WRITE(.BILINE,X)
- KILL X
- +22 ;---> Preserve line number of Patient demographic line, for record
- +23 ;---> line count and for address and phone lines below.
- +24 SET BIPLIN=BILINE-1
- SET BIPLIN1=BILINE+1
- +25 ;
- +26 ;---> Next section: Write specifed Additional Information in BINFO.
- +27 ;
- +28 ;--> Check if BINFO("ALL") exists. If so, set BIALL=1 and display all Info.
- +29 NEW BIALL
- SET BIALL=0
- +30 IF $DATA(BINFO("ALL"))
- SET BIALL=1
- +31 ;
- +32 ;---> First, build Data String, BINFODS, of Add Info elements (2nd piece of
- +33 ;---> BI TABLE ADD INFO File #9002084.82).
- +34 NEW BINFODS
- +35 Begin DoDot:1
- +36 NEW N
- SET N=0
- +37 FOR
- SET N=$ORDER(BINFO(N))
- IF 'N
- QUIT
- Begin DoDot:2
- +38 SET BINFODS=$GET(BINFODS)_$PIECE($GET(^BIADDIN(N,0)),U,2)_"^"
- End DoDot:2
- +39 IF '$GET(BINFODS)
- SET BINFODS=0
- End DoDot:1
- +40 ;
- +41 ;---> Forecast.
- +42 IF ((BINFODS[15)!BIALL)
- DO WRITE(.BILINE)
- DO FORECAST(.BILINE,BIDFN,$GET(BIFDT))
- +43 ;
- +44 ;---> Address.
- +45 IF ((BINFODS[12)!BIALL)
- Begin DoDot:1
- +46 NEW X
- SET X="Address..: "_$EXTRACT($$STREET^BIUTL1(BIDFN),1,38)
- +47 SET BIPLIN1=BIPLIN1+1
- +48 DO APPEND(BIPLIN1,X,.BILINE)
- +49 SET X=" "_$$CTYSTZ^BIUTL1(BIDFN)
- SET BIPLIN1=BIPLIN1+1
- +50 DO APPEND(BIPLIN1,X,.BILINE)
- End DoDot:1
- +51 ;
- +52 ;---> Phone Number.
- +53 IF ((BINFODS[11)!BIALL)
- Begin DoDot:1
- +54 NEW X
- SET X="Phone....: "_$$HPHONE^BIUTL1(BIDFN)
- SET BIPLIN1=BIPLIN1+1
- +55 DO APPEND(BIPLIN1,X,.BILINE)
- End DoDot:1
- +56 ;
- +57 ;---> Parent/Guardian.
- +58 IF ((BINFODS[17)!BIALL)
- Begin DoDot:1
- +59 NEW X
- SET X="Parent...: "_$$PARENT^BIUTL1(BIDFN)
- SET BIPLIN1=BIPLIN1+1
- +60 DO APPEND(BIPLIN1,X,.BILINE)
- End DoDot:1
- +61 ;
- +62 ;---> Case Manager.
- +63 IF ((BINFODS[18)!BIALL)
- Begin DoDot:1
- +64 NEW X
- SET X="Case Mgr.: "_$$CMGR^BIUTL1(BIDFN,1,1)
- SET BIPLIN1=BIPLIN1+1
- +65 DO APPEND(BIPLIN1,X,.BILINE)
- End DoDot:1
- +66 ;
- +67 ;---> Reason Inactivated.
- +68 IF ((BINFODS[19)!BIALL)
- Begin DoDot:1
- +69 IF ('$$INACT^BIUTL1(BIDFN))
- QUIT
- +70 NEW X
- SET X="Inactive.: "_$$INACTRE^BIUTL1(BIDFN)
- SET BIPLIN1=BIPLIN1+1
- +71 DO APPEND(BIPLIN1,X,.BILINE)
- End DoDot:1
- +72 ;
- +73 ;---> Immunization History.
- +74 IF (BINFODS[13)!(BINFODS[14)!(BINFODS[20)!(BINFODS[22)!(BINFODS[25)!BIALL
- Begin DoDot:1
- +75 ;---> Write either History or History w/Lot#'s, VFC, with or without Skin Tests.
- +76 NEW X
- Begin DoDot:2
- +77 IF (BINFODS[14)&(BINFODS'[25)
- SET X=2
- QUIT
- +78 IF (BINFODS'[14)&(BINFODS[25)
- SET X=5
- QUIT
- +79 IF (BINFODS[14)&(BINFODS[25)
- SET X=7
- QUIT
- +80 SET X=1
- End DoDot:2
- +81 ;
- +82 ;---> Include location where shot was given.
- +83 NEW Y
- SET Y=$SELECT(BINFODS[22:1,1:0)
- +84 NEW Z
- SET Z=1
- +85 IF (BINFODS[20)
- Begin DoDot:2
- +86 IF ((BINFODS'[13)&(BINFODS'[14)&(BINFODS'[25))
- SET Z=2
- QUIT
- +87 SET Z=0
- End DoDot:2
- +88 DO WRITE(.BILINE)
- DO WRITE(.BILINE," History:")
- +89 DO HISTORY1^BILETPR1(.BILINE,BIDFN,X,,"BIDULV",,,Z,Y,.BIMMRF,.BIMMLF)
- End DoDot:1
- +90 ;
- +91 ;
- +92 ;---> Refusals.
- +93 IF ((BINFODS[23)!BIALL)
- Begin DoDot:1
- +94 NEW A,X1,X2,X3
- SET (X1,X2,X3)=""
- +95 DO CONTRA^BIUTL11(BIDFN,.A,1,1)
- +96 IF ('$DATA(A))
- QUIT
- +97 DO WRITE(.BILINE)
- +98 SET X1=" Refusals: "
- +99 NEW N,M
- SET N=0
- SET M=0
- +100 FOR
- SET N=$ORDER(A(N))
- IF 'N
- QUIT
- Begin DoDot:2
- +101 NEW X
- SET M=M+1
- +102 SET X=$$VNAME^BIUTL2($$HL7TX^BIUTL2(N))_" ("_$$SLDT2^BIUTL5($PIECE(A(N),U,2),1)_")"
- +103 IF "235689"[M
- SET X=", "_X
- +104 IF M<4
- SET X1=X1_X
- QUIT
- +105 IF M<7
- IF M=4
- SET X2=" "
- SET X1=X1_","
- SET X2=X2_X
- QUIT
- +106 IF M=7
- SET X3=" "
- SET X2=X2_","
- SET X3=X3_X
- QUIT
- End DoDot:2
- +107 IF X1]""
- DO WRITE(.BILINE,X1)
- +108 IF X2]""
- DO WRITE(.BILINE,X2)
- +109 IF X3]""
- DO WRITE(.BILINE,X3)
- End DoDot:1
- +110 ;
- +111 ;---> Next Appointment.
- +112 IF ((BINFODS[21)!BIALL)
- Begin DoDot:1
- +113 ;---> Write either Patient's Next Appointment if there is one.
- +114 NEW X
- SET X=$$NEXTAPPT^BIUTL11(BIDFN)
- +115 IF X]""
- Begin DoDot:2
- +116 SET X=" Next Appointment: "_$EXTRACT(X,1,57)
- +117 DO WRITE(.BILINE)
- DO WRITE(.BILINE,X)
- End DoDot:2
- End DoDot:1
- +118 ;
- +119 ;---> Directions to House.
- +120 IF ((BINFODS[16)!BIALL)
- Begin DoDot:1
- +121 IF '$ORDER(^AUPNPAT(BIDFN,12,0))
- QUIT
- +122 DO WRITE(.BILINE)
- +123 NEW X
- SET X=" Directions to the home of "_$$NAME^BIUTL1(BIDFN,1)_":"
- +124 DO WRITE(.BILINE,X)
- +125 NEW N
- SET N=0
- +126 FOR
- SET N=$ORDER(^AUPNPAT(BIDFN,12,N))
- IF 'N
- QUIT
- Begin DoDot:2
- +127 SET X=$GET(^AUPNPAT(BIDFN,12,N,0))
- +128 DO WRITE(.BILINE," "_X)
- End DoDot:2
- End DoDot:1
- +129 ;
- +130 IF '$GET(BIDASH)
- DO WRITE(.BILINE," "_$$SP^BIUTL5(73,"-"))
- +131 ;---> Mark the top line of this record with the total lines in it.
- +132 DO MARK^BIW(BIPLIN,BILINE-BIPLIN,"BIDULV")
- +133 QUIT
- +134 ;
- +135 ;
- +136 ;----------
- FORECAST(BILINE,BIDFN,BIFDT) ;EP
- +1 ;---> Retrieve and store Imm Forecast in WP ^TMP global.
- +2 ;---> Parameters:
- +3 ; 2 - BILINE (ret) Last line written into ^TMP array.
- +4 ; 3 - BIDFN (req) Patient's IEN in VA PATIENT File #2.
- +5 ; 4 - BIFDT (opt) Forecast Date.
- +6 ;
- +7 IF '$DATA(BILINE)
- QUIT
- IF '$GET(BIDFN)
- QUIT
- +8 ;
- +9 ;---> If Patient is deceased, display date instead of forecast.
- +10 NEW X
- SET X=$$DECEASED^BIUTL1(BIDFN,1)
- +11 IF X
- DO WRITE(.BILINE)
- DO WRITE(.BILINE," DECEASED: "_$$TXDT^BIUTL5(X))
- QUIT
- +12 ;
- +13 ;---> If Forecast Date not provided, set it equal to today.
- +14 IF '$GET(BIFDT)
- SET BIFDT=DT
- +15 ;
- +16 ;---> RPC to gather Immunization History.
- +17 ; BIRETVAL - Return value of valid data from RPC.
- +18 ; BIRETERR - Return value (text string) of error from RPC.
- +19 ;
- +20 NEW BIRETVAL,BIRETERR
- SET BIRETVAL=""
- +21 ;---> Next line: 4th param=1 to not call Immserve because forecast
- +22 ;---> just got updated in retrieving patients: +225^BIDUR.
- +23 DO IMMFORC^BIRPC(.BIRETVAL,BIDFN,BIFDT,1)
- +24 ;
- +25 ;---> If BIRETERR has a value, store it and quit.
- +26 SET BIRETERR=$PIECE(BIRETVAL,BI31,2)
- +27 IF BIRETERR]""
- Begin DoDot:1
- +28 DO WRITE(.BILINE)
- DO WRITE(.BILINE," "_BIRETERR)
- DO WRITE(.BILINE)
- End DoDot:1
- QUIT
- +29 ;
- +30 ;---> Set BIFDTORC=to the Immunization Forecast for this patient.
- +31 NEW BIFDTORC,I,V
- SET V="|"
- SET BIFDTORC=$PIECE(BIRETVAL,BI31,1)
- +32 ;
- +33 ;---> Loop through "^"-pieces of Imm Forecast, getting data.
- +34 FOR I=1:1
- SET Y=$PIECE(BIFDTORC,U,I)
- IF Y=""
- QUIT
- Begin DoDot:1
- +35 NEW X,Z
- SET X=$SELECT(I=1:" Needs: ",1:" ")
- +36 ;---> If the forecast for this vaccine contains an error,
- +37 ;---> write Vaccine Group Name Error, such as, $P("DTP ERROR:",":").
- +38 SET Z=$PIECE(Y,V)
- SET Z=X_$PIECE(Z,":")
- +39 DO WRITE(.BILINE,Z)
- End DoDot:1
- +40 QUIT
- +41 ;
- +42 ;
- +43 ;----------
- WRITE(BILINE,BIVAL) ;EP
- +1 ;---> Write a line to the ^TMP global for WP or Listman.
- +2 ;---> Parameters:
- +3 ; 1 - BILINE (ret) Last line# in the WP ^TMP global.
- +4 ; 2 - BIVAL (opt) Value/text of line (Null=blank line).
- +5 ;
- +6 IF '$DATA(BILINE)
- QUIT
- +7 IF $GET(BIVAL)=""
- SET BIVAL=" "
- +8 SET BILINE=BILINE+1
- SET ^TMP("BIDULV",$JOB,BILINE,0)=BIVAL
- +9 QUIT
- +10 ;
- +11 ;
- +12 ;----------
- APPEND(BIPLIN1,BIVAL,BILINE) ;EP
- +1 ;---> Append BIVAL to existing line or create new line.
- +2 ;---> Parameters:
- +3 ; 1 - BIPLIN1 (ret) Line down from demog line to be added to.
- +4 ; 2 - BIVAL (opt) Value/text of line (Null=blank line).
- +5 ; 3 - BILINE (ret) Last line# in the WP ^TMP global.
- +6 ;
- +7 IF '$DATA(BILINE)
- QUIT
- +8 IF $GET(BIVAL)=""
- QUIT
- +9 ;
- +10 ;---> If line already exists, append to it.
- +11 NEW X
- +12 IF $DATA(^TMP("BIDULV",$JOB,BIPLIN1,0))
- SET X=^(0)
- Begin DoDot:1
- +13 SET X=$$PAD^BIUTL5(X,32)_BIVAL
- +14 SET ^TMP("BIDULV",$JOB,BIPLIN1,0)=X
- End DoDot:1
- QUIT
- +15 ;
- +16 ;---> If line doesn't exist, create it.
- +17 DO WRITE(.BILINE,$$SP^BIUTL5(32)_BIVAL)
- +18 QUIT
