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

SCRPW29.m

Go to the documentation of this file. 
  1. SCRPW29 ;RENO/KEITH - ACRP Ad Hoc Report (cont.) ; 03 Aug 98  8:56 PM
  1.  ;;5.3;Scheduling;**144,1015**;AUG 13, 1993;Build 21
  1.  ;
  1. XY(X) ;Maintain $X, $Y
  1.  ;Required input: X=screen handling
  1.  N DX,DY S DX=$X,DY=$Y W X X SDXY Q ""
  1.  ;
  1. MAR ;Margin note
  1.  I $G(SDPAR("F",2))!$D(SDPAR("PF")),$P(SDPAR("F",6),U)="F" W !,"This report requires 132 column output!",!
  1.  Q
  1.  ;
  1. PFC() ;Print field choice
  1.  Q $S('$D(SDPAR("F",3)):"","EB"[$P(SDPAR("F",3),U):"X:ADDL. PRINT FIELDS;",1:"")
  1.  ;
  1. PF ;Print fields prompter
  1.  Q:SDOUT!'$D(SDPAR("F",3))  Q:SDOUT!("EB"'[$P(SDPAR("F",3),U))
  1.  K SDBOT S SDBOT(1)="Additional print field selection",SDBOT(2)="Additional print fields that are selected will be included in the output of",SDBOT(3)="encounter, visit, or unique patient detail lists,"
  1.  D DISP^SCRPW23("A D D I T I O N A L   P R I N T   F I E L D S",.SDBOT)
  1.  S SDD=$P($G(SDPAR("F",4)),U) Q:SDOUT!(SDD="")  S SDD=$S(SDD="E":1,1:2),SDS1="PF",(SDOUT,SDNUL)=0
  1.  D PFL S SDS1="PF" F  Q:SDOUT!SDNUL  D PF1
  1.  Q
  1.  ;
  1. PF1 W !!?10,$$XY(IORVON),"Select additional print fields for patient detail:  (optional)",$$XY(IORVOFF)
  1.  K DIR S DIR("A")="Specify additional print field",DIR("?")="These fields will be included in the patient detail list output."
  1.  S S1=$$DIR^SCRPW23(.DIR,1,"","","O",SDD) Q:SDOUT!SDNUL
  1.  K DIR S DIR("A")="Select "_$P(S1,U,2)_" category",S2=$$DIR^SCRPW23(.DIR,2,"",$P(S1,U),"O",SDD,1) Q:SDOUT  I SDNUL S SDNUL=0 Q
  1.  S SDSEL=$P(S1,U)_$P(S2,U) G:$D(SDPAR("PFX",SDSEL)) PFD
  1.  S SDS2=$P(^TMP("SCRPW",$J,"ACT",SDSEL),T,11),SDS3=$O(SDPAR(SDS1,SDS2,""),-1)+1,SDPAR(SDS1,SDS2,SDS3)=SDSEL_U_$P(S1,U,2)_U_$P(S2,U,2),SDPAR("PFX",SDSEL,SDS2,SDS3)=""
  1.  Q
  1.  ;
  1. PFD N DIR S DIR(0)="Y",DIR("A")="This item is already selected as a print field, do you want to delete it",DIR("B")="NO" D ^DIR Q:$D(DTOUT)!$D(DUOUT)
  1.  I Y S S1=$O(SDPAR("PFX",SDSEL,"")),S2=$O(SDPAR("PFX",SDSEL,S1,"")) K SDPAR("SDX",SDSEL),SDPAR("PF",S1,S2) W !,"deleted..."
  1.  Q
  1.  ;
  1. PFL ;List print field selections
  1.  Q:SDOUT!'$D(SDPAR("PF"))  N SDOUT,SDI,SDX S (SDI,SDOUT)=0 W !!,"Additional print fields currently selected:"
  1.  F S1=2,1 S S2=0 F  S S2=$O(SDPAR("PF",S1,S2)) Q:SDOUT!'S2  S SDI=SDI+1 D:SDI#10=0 WAIT Q:SDOUT  S SDX=SDPAR("PF",S1,S2) W !,$J($P(SDX,U,2)_": ",30),$P(SDX,U,3)
  1.  Q:SDOUT  D WAIT Q
  1.  ;
  1. WAIT N DIR S DIR(0)="E" W ! D ^DIR S:'Y SDOUT=1 W ! Q
  1.  ;
  1. PFR ;Remove print fields per parameter re-edits
  1.  I $P($G(SDPAR("F",1)),U)="S"!($P($G(SDPAR("F",3)),U)="D") K SDPAR("PF"),SDPAR("PFX") Q
  1.  Q:SDOUT!($P($G(SDPAR("F",4)),U)="E")
  1.  S S2=0 F  S S2=$O(SDPAR("PF",1,S2)) Q:SDOUT!'S2  S SDSEL=$P(SDPAR("PF",1,S2),U) K SDPAR("PFX",SDSEL),SDPAR("PF",1,S2)
  1.  Q
  1.  ;
  1. APFP ;Addl. print fields print
  1.  N SDC,SDC1,SDII,SDIII,S1,S2,SDX,SDY,SDACT,SDOE0 S SDII=0,SDC=$S(SDF(4)="E":81,SDF(4)="V":70,1:63) D:'SDI APF(2) D APF(1) W:$D(SDPAR("PF")) ! Q
  1.  ;
  1. APF(S1) ;Addl. print field
  1.  S S2=0 F  S S2=$O(SDPAR("PF",S1,S2)) Q:SDOUT!'S2  S SDY=SDPAR("PF",S1,S2),SDACT=^TMP("SCRPW",$J,"ACT",$P(SDY,U)) D:$Y>(IOSL-4) HDR1 Q:SDOUT  W:SDII ! W ?(SDC),$P(SDACT,T),": " S SDII=SDII+1 D APF1
  1.  Q
  1.  ;
  1. APF1 K SDX S SDOE0=$$OE0() X $P(SDACT,T,7) S SDIII=0,SDX="",SDC1=SDC+2+$L($P(SDACT,T)) F  S SDX=$O(SDX(SDX)) Q:SDOUT!(SDX="")  D:$Y>(IOSL-2) HDR1 Q:SDOUT  W:SDIII ! W ?(SDC1),$E($P(SDX(SDX),U,2),1,(51-(SDC1-SDC)+(81-SDC))) S SDIII=SDIII+1
  1.  Q
  1.  ;
  1. OE0() ;Get encounter node
  1.  Q:SDOUT!("UV"[SDF(4)) U_DFN_U
  1.  Q $$GETOE^SDOE(SDOE)
  1.  ;
  1. HDR1 D HDR("Report Detail"),HD2,DPHD S SDI=0,(SDII,SDIII)=1 Q
  1.  ;
  1. VF(SDISP) ;Verify format parameters
  1.  N SDX,SDI,SDV S SDX=$G(SDPAR("F",1)) I '$L(SDX) S SDV="Format" G VQ
  1.  G @("VF"_$P(SDX,U))
  1.  ;
  1. VFD K SDPAR("F",2) F SDI=3,6 S SDV=$D(SDPAR("F",SDI)) Q:'SDV
  1.  I 'SDV S SDV="Format" G VQ
  1.  S SDV=$P(SDPAR("F",3),U) I "EB"[SDV,'$D(SDPAR("F",4)) S SDV="Format" G VQ
  1.  I "DB"[SDV,'$D(SDPAR("F",5)) S SDV="Format" G VQ
  1.  Q 0
  1.  ;
  1. VFS F SDI=3,4,5 K SDPAR("F",SDI)
  1.  F SDI=2,6 S SDV=$D(SDPAR("F",SDI)) Q:'SDV
  1.  I 'SDV S SDV="Format" G VQ
  1.  Q 0
  1.  ;
  1. VP(SDISP) ;Verify perspective parameters
  1.  I '$D(SDPAR("P",1)) S SDV="Perspective" G VQ
  1.  I $P(SDPAR("F",1),U)="D",'$D(SDPAR("P",1,4)) S SDV="Perspective" G VQ
  1.  Q 0
  1.  ;
  1. VL(SDISP) ;Verify limitation parameters
  1.  N SDI,SDV F SDI=1,2 S SDV=$D(SDPAR("L",SDI)) Q:'SDV
  1.  I 'SDV S SDV="Limitation" G VQ
  1.  Q 0
  1.  ;
  1. VO(SDISP) ;Verify output order parameter
  1.  I '$D(SDPAR("O",1)) S SDV="Order" G VQ
  1.  Q 0
  1.  ;
  1. VQ ;Prompt for re-edit
  1.  ;Required input: SDV=validation area
  1.  I $G(SDISP) W !,$C(7),$$XY(IORVON)," ",SDV," parameters are incomplete.",$$XY(IORVOFF) S SDOUT=1 Q 0
  1.  N DIR S DIR(0)="Y",DIR("A")=SDV_" parameters are incomplete.  Re-edit",DIR("B")="YES" D ^DIR I $D(DTOUT)!$D(DUOUT)!'$G(Y) S SDOUT=1 Q 0
  1.  Q 1
  1.  ;
  1. DDPH(SDI) ;Detail dx/procedure header
  1.  Q:SDOUT  N SDX S SDX=$E(SDF(5)) I $L(SDF(5))>1 F SDII=2:1:$L(SDF(5)) S SDX=SDX_" "_$E(SDF(5),SDII)
  1.  S SDX="D E T A I L   O F   T O P   "_SDX_$S(SDI="D":"   D I A G N O S I S E S",1:"   P R O C E D U R E S")
  1.  W !?(IOM-$L(SDX)\2),SDX,!?(IOM-$L(SDX)\2),$E(SDLINE,1,$L(SDX))
  1.  I SDI="D" W !?(SDCOL),"Diagnosis",?(SDCOL+43),"Primary",?(SDCOL+56),"Secondary",?(SDCOL+75),"Total"
  1.  I SDI="D" W !?(SDCOL),"------------------------------------",?(SDCOL+40),"----------",?(SDCOL+55),"----------",?(SDCOL+70),"----------"
  1.  I SDI="P" W !?(SDCOL+13),"Procedures",?(SDCOL+61),"Total",!?(SDCOL+13),"--------------------------------------",?(SDCOL+56),"----------"
  1.  Q
  1.  ;
  1. DPHD ;Detail patient subheader
  1.  Q:SDOUT  N SDX S SDX="D E T A I L   O F   P A T I E N T   "_$S(SDF(4)="E":"E N C O U N T E R S",SDF(4)="V":"V I S I T S",1:"U N I Q U E S")
  1.  W !?(IOM-$L(SDX)\2),SDX,!?(IOM-$L(SDX)\2),$E(SDLINE,1,$L(SDX))
  1.  I SDF(4)="E" W !?(SDCOL),"Patient:",?(SDCOL+20),"SSN:",?(SDCOL+32),"Date:",?(SDCOL+52),"Location:" D APFH(81) W !?(SDCOL),$E(SDLINE,1,18),?(SDCOL+20),$E(SDLINE,1,10),?(SDCOL+32),$E(SDLINE,1,18),?(SDCOL+52),$E(SDLINE,1,28) D APFL(81)
  1.  I SDF(4)="V" W !?(SDCOL+13),"Patient:",?(SDCOL+45),"SSN:",?(SDCOL+57),"Date:" D APFH(70) W !?(SDCOL+13),$E(SDLINE,1,30),?(SDCOL+45),$E(SDLINE,1,10),?(SDCOL+57),$E(SDLINE,1,11) D APFL(70)
  1.  I SDF(4)="U" W !?(SDCOL+19),"Patient:",?(SDCOL+51),"SSN:" D APFH(63) W !?(SDCOL+19),$E(SDLINE,1,30),?(SDCOL+51),$E(SDLINE,1,10) D APFL(63)
  1.  Q
  1.  ;
  1. APFH(SDC) ;Addl. print field subheader
  1.  Q:SDOUT!'$D(SDPAR("PF"))  W ?(SDC),"Additional print fields:" Q
  1.  ;
  1. APFL(SDC) ;Addl. print field subheader, cont.
  1.  Q:SDOUT!'$D(SDPAR("PF"))  W ?(SDC),$E(SDLINE,1,51) Q
  1.  ;
  1. HD1 ;Subheader for summary
  1.  Q:SDOUT  I SDCOL=0 W !?77,"Prior",?87,"Prior",?97,"Prior",?105,"Percent",?115,"Percent",?125,"Percent"
  1.  I SDCOL=0 W !?78,"Year",?88,"Year",?98,"Year",?106,"Change",?116,"Change",?126,"Change"
  1.  W !?(SDCOL),$P(SDPAR("P",1,1),U,2),":",?(SDCOL+44),"Encount.",?(SDCOL+56),"Visits",?(SDCOL+65),"Uniques"
  1.  I SDCOL=0 W ?74,"Encount.",?86,"Visits",?95,"Uniques",?104,"Encount.",?116,"Visits",?125,"Uniques"
  1.  W !?(SDCOL),"------------------------------------------  --------  --------  --------  " W:SDCOL=0 "--------  --------  --------  --------  --------  --------" Q
  1.  ;
  1. HD2 Q:SDOUT  N SDI F SDI=1,2 W !?(IOM-$L(SDPTX(SDI))\2),SDPTX(SDI)
  1.  W !,SDLINE Q
  1.  ;
  1. HDR(SDTITL) ;Print report header
  1.  I $E(IOST)="C",SDPAGE>1 N DIR S DIR(0)="E" D ^DIR S SDOUT=Y'=1 Q:SDOUT
  1.  D STOP^SCRPW26 Q:SDOUT  I '$L($G(SDXY)) S SDXY=^%ZOSF("XY")
  1.  D:'$G(SDHIN) HIN^SCRPW27 W:SDPAGE>1 @IOF N DX,DY S (DX,DY)=0 X SDXY
  1.  W SDLINE,!?(IOM-28\2),"<*>  ACRP AD HOC REPORT  <*>" I $L(SDTITLX) W !?(IOM-$L(SDTITLX)\2),SDTITLX
  1.  W !?(IOM-$L(SDTITL)\2),SDTITL,!,SDLINE,! I $L(SDPBDT),$L(SDPEDT) W "For date range: ",SDPBDT," to ",SDPEDT,!
  1.  W "Date printed: ",SDPNOW,?(IOM-7-$L(SDPAGE)),"Page: ",SDPAGE,!,SDLINE S SDPAGE=SDPAGE+1 Q