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

BISCAN.m

Go to the documentation of this file. 
  1. BISCAN ;IHS/CMI/MWR - SCAN PATIENT DB FOR <36 MTHS, ADD TO IMM DB; MAY 10, 2010
  1.  ;;8.5;IMMUNIZATION;;SEP 01,2011
  1.  ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
  1.  ;;  SCAN PATIENT DATABASE FOR PATIENTS <36 MTHS NOT IN IMM DB.
  1.  ;;  PATCH 1: Correct Age Range in report from 1-36 to 0-35.  REVIEW+9
  1.  ;;           Also disabled PREVINA (no longer stuffing previously inactive).
  1.  ;;           Also "please hold..." prompt while getting patient total. SCAN+11
  1.  ;;           Also do not add patient if Ineligible in Registration.  SCAN+40
  1.  ;
  1.  ;----------
  1. START ;EP
  1.  ;---> Scan for patients in ^AUPNPAT <36 mths not in Imm database ^BIP.
  1.  ;
  1.  D SETVARS^BIUTL5 S BIPOP=0 N BICC
  1.  D
  1.  .D PROMPT(.BICC,.BIPOP) Q:BIPOP
  1.  .Q:BIPOP
  1.  .D SCAN(.BICC,.BIPOP) Q:BIPOP
  1.  .D REVIEW
  1.  D EXIT(BIPOP)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. PROMPT(BICC,BIPOP) ;EP
  1.  ;---> Describe conversion.
  1.  ;     1 - BICC  (ret) Current Community array.
  1.  ;     2 - BIPOP (ret) BIPOP=1 If quit, fail, DTOUT, DUOUT.
  1.  ;
  1.  N Z S Z="",BIPOP=0,Z="YES"
  1.  D TITLE,TEXT1 W !
  1.  D DIRZ^BIUTL3(.BIPOP)
  1.  Q:BIPOP
  1.  ;
  1.  ;---> Current Community.
  1.  D CC^BIOUTPT(.BICC,"BISCAN",.BIPOP)
  1.  Q:BIPOP
  1.  ;
  1.  D TITLE W !!
  1.  D DIR^BIFMAN("Y",.Y,.BIPOP,"     Do you wish to continue with the Scan",Z)
  1.  Q:BIPOP
  1.  S:Y<1 BIPOP=1
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. RESET ;EP
  1.  ;---> To satisfy return from call to BIOUTPT.
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. SCAN(BICC,BIPOP) ;EP
  1.  ;---> Convert patients to new file/register.
  1.  ;     1 - BICC  (ret) Current Community array.
  1.  ;     2 - BIPOP (ret) BIPOP=1 If quit, fail, DTOUT, DUOUT.
  1.  ;
  1.  K ^BITMP($J)
  1.  N BIERR,BIFACT,BIX,BIY,N
  1.  ;
  1.  ;---> Check for DUZ(2).
  1.  I '$G(DUZ(2)) D ERRCD^BIUTL2(105,,1) Q
  1.  ;
  1.  ;********** PATCH 1, SEP 21,2006, IHS/CMI/MWR
  1.  ;---> Hold prompt while getting total patient count.
  1.  W !!?12,"Please hold..."
  1.  ;**********
  1.  ;
  1.  ;
  1.  S N=0 F  S N=$O(^AUPNPAT(N)) Q:'N  S BIFACT=N
  1.  S:BIFACT<1 BIFACT=1 S BIFACT=BIFACT\50
  1.  S (BIPOP,BIX,BIY)=0
  1.  ;
  1.  D TITLE
  1.  W !!?12,"Converting Patients to the new Register..."
  1.  W !!?12,"0%---10---20---30---40---50---60---70---80---90---100%"
  1.  W !?12,"|"
  1.  ;
  1.  ;---> Loop through the RPMS Patient global, adding to
  1.  ;---> new BI Patient global.
  1.  ;---> * Consider using DOB xref (time versus reliability?).
  1.  S BIDFN=0,BIPATS=0
  1.  F  S BIDFN=$O(^AUPNPAT(BIDFN)) Q:'BIDFN  Q:$G(BIERR)]""  D
  1.  .;
  1.  .;---> Display bar graph of progress.
  1.  .S BIX=BIX+1 I BIFACT,'(BIX#BIFACT)&(BIY<51) W "=" S BIY=BIY+1
  1.  .;
  1.  .;---> Quit if this patient already exists in the Imm Patient File.
  1.  .Q:$D(^BIP(BIDFN,0))
  1.  .;---> Quit if patient does not have an Active Chart at this site.
  1.  .Q:$$INACTREG^BIUTL1(BIDFN,DUZ(2))
  1.  .;
  1.  .;********** PATCH 1, SEP 21,2006, IHS/CMI/MWR
  1.  .;---> Quit if patient is Ineligible in RPMS Registration.
  1.  .Q:$$INELIG^BIUTL1(BIDFN)
  1.  .;**********
  1.  .;
  1.  .;---> Quit if patient is not less than 36 months.
  1.  .Q:($$AGE^BIUTL1(BIDFN,2,$G(DT))>35)
  1.  .;---> Quit if patient is deceased.
  1.  .Q:$$DECEASED^BIUTL1(BIDFN)
  1.  .;---> Quit If patient does not have one of the selected Current Communities.
  1.  .Q:$$CURCOM^BIEXPRT2(BIDFN,.BICC)
  1.  .;
  1.  .;---> Add patient to ^BIP Imm Database.
  1.  .D ADD(BIDFN,.BIPATS,.BIERR)
  1.  ;
  1.  I $G(BIERR)]"" W !!?3,BIERR D DIRZ^BIUTL3() Q
  1.  ;
  1.  ;---> Update Zero Node of BI PATIENT File #9002084.
  1.  N M,N S (L,N,T)=0 F  S N=$O(^BIP(N)) Q:'N  S L=N,T=T+1
  1.  S $P(^BIP(0),U,3,4)=L_U_T
  1.  ;
  1.  N BII F BII=1:1:50-BIY W "="
  1.  W "|",!?33,"Complete"
  1.  W !!?12,"Patients added to the new Immunization Register: ",BIPATS
  1.  W !!?12,"Total Patients in the new Immunization Register....: ",T
  1.  W !!!!!! D DIRZ^BIUTL3(.BIPOP) Q:BIPOP
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. ADD(BIDFN,BIPATS,BIERR) ;EP
  1.  ;---> Add patient to new Immunization database.
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN  (req) Patient's IEN in VA PATIENT File #2.
  1.  ;     2 - BIPATS (opt) Bookeeper node, total patients in ^BIP(0)
  1.  ;     3 - BIERR  (ret)   Error text, if any.
  1.  ;
  1.  Q:'$D(^AUPNPAT(BIDFN,0))
  1.  S:'$D(BIPATS) BIPATS=0
  1.  ;
  1.  D ADDPAT^BIPATE(BIDFN,1665,.BIERR,,,1)
  1.  Q:($G(BIERR)]"")
  1.  S ^BITMP($J,BIDFN)="",BIPATS=BIPATS+1
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. REVIEW ;EP
  1.  ;---> Review/Print List of Patients automatically activated.
  1.  ;
  1.  D TITLE,TEXT2 W !
  1.  N BIPOP S BIPOP=0
  1.  D DIR^BIFMAN("Y",.Y,.BIPOP,"     Review List of Auto Activated now")
  1.  Q:BIPOP
  1.  Q:Y<1
  1.  ;
  1.  ;********** PATCH 1, SEP 21,2006, IHS/CMI/MWR
  1.  ;---> Correct Age Range in report from 1-36 to 0-35.
  1.  ;K BICC S BIPG="5^^^^"_DT_":"_DT,BIAG="1-36"
  1.  K BICC S BIPG="5^^^^"_DT_":"_DT,BIAG="0-35"
  1.  ;**********
  1.  ;
  1.  D ^BIDU
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. PREVINA ;EP
  1.  ;---> Stuff "Previously Inactivated" in the .16 Field of the BI PATIENT
  1.  ;---> File for any patients who were Inactive prior to v8.1.
  1.  ;
  1.  ;********** PATCH 1, SEP 21,2006, IHS/CMI/MWR
  1.  ;---> No longer stuffing "Previously Inactivated".
  1.  Q
  1.  ;**********
  1.  ;
  1.  N N S N=0
  1.  F  S N=$O(^BIP(N)) Q:'N  D
  1.  .Q:'$P($G(^BIP(N,0)),"^",8)
  1.  .S $P(^BIP(N,0),"^",16)="p"
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. TEXT1 ;EP
  1.  ;;
  1.  ;;This program will scan the RPMS Patient Database for children who
  1.  ;;are less than 36 months old.  Of those children, any who are not in
  1.  ;;the Immunization Database and who live in one of the Communities
  1.  ;;you select will be added to the Immunization Register.
  1.  ;;
  1.  ;;NOTE: This scan program, if interrupted, may be restarted at any time.
  1.  ;;      It may also be rerun at any time.  It will not create duplicates.
  1.  ;;
  1.  ;;The next screen will provide an opportunity to select specific
  1.  ;;communities from which patients will be scanned.  (This is the
  1.  ;;"Current Community" field in RPMS Patient Registration.)  You will have
  1.  ;;the opportunity to automatically use the GPRA set of communities.
  1.  ;;
  1.  ;;
  1.  ;;
  1.  D PRINTX("TEXT1",5)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. TEXT2 ;EP
  1.  ;;
  1.  ;;You may review the list of Patients who have been Automatically
  1.  ;;Activated today.  Would you like to view that list now?
  1.  ;;
  1.  ;;
  1.  D PRINTX("TEXT2",5)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. PRINTX(BILINL,BITAB) ;EP
  1.  Q:$G(BILINL)=""
  1.  N I,T,X S T="" S:'$D(BITAB) BITAB=5 F I=1:1:BITAB S T=T_" "
  1.  F I=1:1 S X=$T(@BILINL+I) Q:X'[";;"  W !,T,$P(X,";;",2)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. EXIT(BIPOP) ;EP
  1.  ;---> EOJ Cleanup.
  1.  ;---> Parameters:
  1.  ;     1 - BIPOP   (opt) BIPOP=1 if DTOUT or DUOUT
  1.  ;
  1.  D:$G(BIPOP)
  1.  .W !!?5,"* SCAN ABORTED. *" D DIRZ^BIUTL3()
  1.  N BIPOP
  1.  D KILLALL^BIUTL8(1)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. TITLE ;EP
  1.  D TITLE^BIUTL5("SCAN FOR PATIENTS <36 MONTHS")
  1.  Q