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