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

GMRAZNAS.m

Go to the documentation of this file. 
  1. GMRAZNAS ; IHS/MSC/MGH - NON-ASSESSED ALLERGY PATIENTS ;08-Aug-2013 15:41;DU
  1.  ;;4.0;Adverse Reaction Tracking;**1007**;Mar 29, 1996;Build 18
  1.  ;
  1. EN ;EP
  1.  N GMRQ,GMRDIV,GMRTYP,GMRBD,GMRED
  1.  W !!,"Report of patients with no allergy assessment who were seen in the dates selected"
  1.  D ASKDATES^APSPUTIL(.GMRBD,.GMRED,.GMRQ,$$FMADD^XLFDT(DT,-90),$$FMADD^XLFDT(DT,-1))
  1.  Q:GMRQ
  1.  S GMRDIV=$$DIR^APSPUTIL("Y","Would you like all divisions","Yes",,.GMRQ)
  1.  Q:GMRQ
  1.  I GMRDIV D
  1.  .S GMRDIV="*"
  1.  E  D  Q:GMRQ
  1.  .S GMRDIV=$$GETIEN^APSPUTIL(40.8,"Select Division: ",.GMRQ)
  1.  Q:GMRQ
  1.  S GMRTYP=+$$DIR^APSPUTIL("S^1:Delimited;2:Regular","Report Type",2,,.GMRQ)
  1.  Q:GMRQ
  1.  D DEV
  1.  Q
  1. DEV ;EP
  1.  N XBRP,XBNS
  1.  S XBRP="OUT^GMRAZNAS"
  1.  S XBNS="GMR*"
  1.  D ^XBDBQUE
  1.  Q
  1. OUT ;EP Run the report
  1.  N FILTER,IEN,OK,ALG,DFN,CNT,UN,GMRBDF,GMREDF
  1.  K ^TMP("GMRALG",$J)
  1.  S CNT=0
  1.  S FILTER="AHI"
  1.  S GMRBDF=$P($TR($$FMTE^XLFDT(GMRBD,"5Z"),"@"," "),":",1,2)
  1.  S GMREDF=$P($TR($$FMTE^XLFDT(GMRED,"5Z"),"@"," "),":",1,2)
  1.  S GMRBD=GMRBD-.01,GMRED=GMRED+.99
  1.  F  S GMRBD=$O(^AUPNVSIT("B",GMRBD)) Q:'+GMRBD!(GMRBD>GMRED)  D
  1.  .S IEN="" F  S IEN=$O(^AUPNVSIT("B",GMRBD,IEN)) Q:'+IEN  D
  1.  ..S OK=$$CHKVST(IEN)
  1.  ..;Get the patient for this visit and check for assessment
  1.  ..S DFN=$$GET1^DIQ(9000010,IEN,.05,"I")
  1.  ..I +OK D
  1.  ...N ALG
  1.  ...S ALG=$$NKA^GMRANKA(DFN)
  1.  ...I ALG="" D
  1.  ....S UN=$$INASSESS^GMRAPEM0(DFN)
  1.  ....I UN=0 D SETDATA(GMRDIV,DFN,IEN)
  1.  ;Print out all the data in the array
  1.  I GMRTYP=1 D DELIM Q
  1.  I GMRTYP=2 D REG
  1.  Q
  1. CHKVST(IEN) ;Check to see its an ambulatory visit
  1.  N RET,LOC,DIV
  1.  S RET=0
  1.  I FILTER[$P($G(^AUPNVSIT(IEN,0)),U,7) D
  1.  .I GMRDIV="*" S RET=1
  1.  .E  D
  1.  ..S LOC=$$GET1^DIQ(9000010,IEN,.22,"I")
  1.  ..I +LOC D
  1.  ...S DIV=$$GET1^DIQ(44,LOC,3.5,"I")
  1.  ...I +DIV=GMRDIV S RET=DIV
  1.  Q RET
  1. SETDATA(DIV,DFN,IEN) ;Put the data into the temp global
  1.  N PRV,NAME,VSTDT,QUIT,PRI,PNAME,DIVNM
  1.  S QUIT=0,PNAME="",DIVNM=""
  1.  S CNT=CNT+1
  1.  S NAME=$$GET1^DIQ(2,DFN,.01)
  1.  S VSTDT=$$GET1^DIQ(9000010,IEN,.01)
  1.  I DIV="*" D
  1.  .S LOC=$$GET1^DIQ(9000010,IEN,.22,"I")
  1.  .I +LOC D
  1.  ..S DIVNM=$$GET1^DIQ(44,LOC,3.5)
  1.  E  S DIVNM=$$GET1^DIQ(40.8,DIV,.01)
  1.  S PRV="" F  S PRV=$O(^AUPNVPRV("AD",IEN,PRV)) Q:'+PRV!(QUIT=1)  D
  1.  .S PRI=$$GET1^DIQ(9000010.06,PRV,.04,"I")
  1.  .I PRI="P" D
  1.  ..S PNAME=$$GET1^DIQ(9000010.06,PRV,.01)
  1.  ..S QUIT=1
  1.  S ^TMP("GMRALG",$J,DIV,DFN,CNT)=NAME_U_VSTDT_U_PNAME_U_DIVNM
  1.  Q
  1. REG ;Output to the screen
  1.  N DIV,DFN,CNT,STRING
  1.  D HDR1
  1.  S DIV=0 F  S DIV=$O(^TMP("GMRALG",$J,DIV)) Q:DIV=""!(+GMRQ)  D
  1.  .S DFN=0 F  S DFN=$O(^TMP("GMRALG",$J,DIV,DFN)) Q:DFN=""!(+GMRQ)  D
  1.  ..S CNT=0
  1.  ..F  S CNT=$O(^TMP("GMRALG",$J,DIV,DFN,CNT)) Q:CNT=""!(+GMRQ)  D
  1.  ...I $Y+4>IOSL,IOST["C-" D PAUS Q:GMRQ  D HDR1
  1.  ...Q:GMRQ=1
  1.  ...S STRING=$G(^TMP("GMRALG",$J,DIV,DFN,CNT))
  1.  ...W !,?1,$E($P(STRING,U,4),1,20),?22,$E($P(STRING,U,1),1,20),?43,$E($P(STRING,U,2),1,20),?64,$E($P(STRING,U,3),1,20)
  1.  Q
  1. DELIM ;Delimeted output
  1.  N DIV,DFN,CNT,STRING
  1.  D HDR2
  1.  S DIV=0 F  S DIV=$O(^TMP("GMRALG",$J,DIV)) Q:DIV=""  D
  1.  .S DFN=0 F  S DFN=$O(^TMP("GMRALG",$J,DIV,DFN)) Q:DFN=""  D
  1.  ..S CNT=0
  1.  ..F  S CNT=$O(^TMP("GMRALG",$J,DIV,DFN,CNT)) Q:CNT=""  D
  1.  ...S STRING=$G(^TMP("GMRALG",$J,DIV,DFN,CNT))
  1.  ...W !,$P(STRING,U,4)_U_$P(STRING,U,1)_U_$P(STRING,U,2)_U_$P(STRING,U,3)
  1.  Q
  1. HDR1 ;Write header
  1.  N LIN
  1.  I IOST["C-" W @IOF
  1.  W !,"Patient with no allergy assessment seen between "_GMRBDF_" and "_GMREDF
  1.  W !,?1,"DIVISION",?22,"PATIENT",?43,"VISIT",?64,"PROVIDER"
  1.  W ! F LIN=1:1:72 W "-"
  1.  W !
  1.  Q
  1. HDR2 ;Write delimeted header
  1.  W !,"Patient with no allergy assessment seen between "_GMRBDF_" and "_GMREDF
  1.  W !,"DIVISION^PATIENT^VISIT^PROVIDER"
  1.  Q
  1. PAUS ;pause
  1.  N DTOUT,DUOUT,DIR
  1.  S DIR("?")="Enter '^' to Halt or Press Return to continue"
  1.  S DIR(0)="FO",DIR("A")="Press Return to continue or '^' to Halt"
  1.  D ^DIR
  1.  I $D(DUOUT) S GMRQ=1
  1.  Q