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

ACHSEPAT.m

Go to the documentation of this file. 
  1. ACHSEPAT ; IHS/ITSC/PMF - PRINT EOBRS BY PATIENT ;  [ 10/16/2001   8:16 AM ]
  1.  ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**22**;JUN 11, 2001;Build 43
  1.  ;ACHS*3.1*22 Modification to fix error if patient is not defined
  1.  ;
  1.  K ACHSPAT,DFN
  1.  W $G(IORVON),!,"THIS REPORT WILL ONLY INCLUDE PROCESSED DOCUMENTS.  ANY UNPROCESSED",!,"DOCUMENT WILL HAVE TO BE PRINTED USING ANOTHER OPTION.",$G(IORVOFF),!!!
  1.  D PTLK^ACHS
  1.  Q:'$D(DFN)
  1.  S ACHSPAT=DFN
  1.  W !
  1.  S (ACHSDIEN,ACHSTIEN,ACHSX)=0
  1. PAT1 ;
  1.  S ACHSDIEN=$O(^ACHSF(DUZ(2),"EOBP",ACHSPAT,ACHSDIEN))
  1.  I ACHSDIEN="" S I=1,ACHSPATI=0 G PATSEL   ;ACHS*3.1*22 ADDED IF TEST
  1.  G:'$D(^ACHSF(DUZ(2),"D",ACHSDIEN)) PAT1  ;ACHS*3.1*22
  1.  S ACHSTIEN=0
  1. PAT2 ;
  1.  S ACHSTIEN=$O(^ACHSF(DUZ(2),"EOBP",ACHSPAT,ACHSDIEN,ACHSTIEN))
  1.  G PAT1:ACHSTIEN=""
  1.  S ACHSDAT=0
  1. PAT3 ;
  1.  S ACHSDAT=$O(^ACHSF(DUZ(2),"EOBP",ACHSPAT,ACHSDIEN,ACHSTIEN,ACHSDAT))
  1.  G:ACHSDAT="" PAT2
  1.  S ACHSX=ACHSX+1,ACHSPAT(ACHSX)=ACHSDIEN_"^"_ACHSTIEN_"^"_ACHSDAT
  1.  G PAT3
  1.  ;
  1. PAT4 ;NOT USED KEPT FOR FUTURE ENHANCEMENTS
  1.  ;S ACHSPATI=$O(^ACHSEOBE("EOBP",DFN,ACHSPATI)) G PATSEL:ACHSPATI=""
  1.  ;S ACHSX=ACHSX+1,ACHSPATI(ACHSX)=DFN_"^"_ACHSPATI
  1.  ;G PAT4
  1.  ;
  1. PATSEL ;
  1.  I ACHSX=0 G PATNO
  1.  I ACHSX=1 S ACHSLST=1 G PATPR ;S:$D(ACHSPAT(ACHS)) PATPR
  1.  W !!,"ENTRY #",?10,"DOCUMENT #",?27,"PATIENT NAME",?56,"CHART #",?67,"TRANS DATE",!,$$REPEAT^XLFSTR("-",79)
  1.  ;S ACHSY=0
  1.  ;F I=1:1:ACHSX D:$D(ACHSPAT(I)) PATSEL1 S ACHSY=ACHSY+1 I ACHSY#10=0 W !!,"Press <RETURN> To Continue" D READ^ACHSFU G PATSEL:Y="" G DIR:Y?1N.N ;D:$D(ACHSPATI(I)) PATSEL2
  1.  F I=I:1:ACHSX D:$D(ACHSPAT(I)) PATSEL1 I I#10=0 D RTRN^ACHS Q:$D(DUOUT)     ;ACHS*3.1*22
  1. DIR ;
  1.  S ACHSLST=$$DIR^XBDIR("L^1:"_I,"ENTER NUMBER(S) OF SELECTION(S)","","","","",1)  ;ACHS*3.1*22
  1.  G PATEND:$D(DUOUT)!$D(DTOUT),PATPR
  1.  ;
  1. PATSEL1 ;
  1.  S ACHSDIEN=$P(ACHSPAT(I),U,1),ACHSTIEN=$P(ACHSPAT(I),U,2),ACHSDAT=$P(ACHSPAT(I),U,3),Y=$$FMTE^XLFDT(9999999-ACHSDAT)
  1.  S ACHSPAT=$P(^ACHSF(DUZ(2),"D",ACHSDIEN,0),U,22),ACHSCHRT=$P(^AUPNPAT(ACHSPAT,41,DUZ(2),0),U,2),ACHSDOC=$P(^ACHSF(DUZ(2),"D",ACHSDIEN,0),U,14)_"-"_ACHSFC_"-"_$P(^(0),U,1)
  1.  S ACHSPAT=$P(^DPT(ACHSPAT,0),U,1)
  1.  D PATSELPR
  1.  Q
  1.  ;
  1. PATSEL2 ;NOT USED KEPT FOR FUTURE ENHANCEMENTS
  1.  ;S ACHSPATI=ACHSPATI(I)
  1.  ;S DFN=$P(ACHSPATI,U,1),ACHSEPAT=$P(ACHSPATI,U,2)
  1.  ;S ACHSPAT=$P(^DPT(DFN,0),U,1),ACHSDOC=$P(^ACHSEOBE(ACHSEPAT,0),U,1),ACHSCHRT=$P(^AUPNPAT(DFN,41,DUZ(2),0),U,2),ACHSDAT=$P(^ACHSEOBE(ACHSEPAT,0),U,8)
  1.  ;S Y=$$FMTE^XLFDT($S($E(ACHSDAT,1,2)>50:2,$E(ACHSDAT,1,2)<50:3)_ACHSDAT)
  1.  ;D PATSELPR
  1.  Q
  1.  ;
  1. PATSELPR ;
  1.  W !,I,".",?10,ACHSDOC,?27,ACHSPAT,?57,ACHSCHRT,?67,Y
  1.  Q
  1.  ;
  1. PATPR ;
  1.  D DEV,BRPT^ACHSFU
  1.  G:Y=0!($D(DUOUT))!($D(DTOUT))!($D(DIRUT)) PATEND
  1.  S ACHSXX=0
  1. PATPR1 ;
  1.  S ACHSXX=ACHSXX+1
  1.  S I=$P(ACHSLST,",",ACHSXX)
  1.  G:I="" PATEND
  1.  D:$D(ACHSPAT(I)) PATPR2
  1.  ;D:$D(ACHSPATI(I)) PATPR3
  1.  G PATPR1
  1.  ;
  1. PATPR2 ;
  1.  S ACHSDIEN=$P(ACHSPAT(I),U,1),ACHSTIEN=$P(ACHSPAT(I),U,2)
  1.  D ^ACHSEOBA,^ACHSEOB2
  1.  Q
  1.  ;
  1. PATPR3 ;NOT USED KEPT FOR FUTURE ENHANCEMENTS
  1.  ;S ACHSNON=ACHSEPAT
  1.  ;D ^ACHSEOBE,^ACHSEOB2
  1.  Q
  1.  ;
  1. PATNO ;
  1.  W !!,"NO EOBRS PROCESSED FOR THIS PATIENT",!!
  1.  I $$DIR^XBDIR("E","Press RETURN...")
  1.  G PATEND
  1.  ;
  1. DEV ;
  1.  W !!
  1.  S %ZIS="P"
  1.  D ^%ZIS
  1.  S ACHSEOIO=IO
  1.  Q
  1.  ;
  1. PATEND ;
  1.  D ^%ZISC,EN^XBVK("ACHS"),^ACHSVAR
  1.  Q
  1.  ;