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

ACHSDNL1.m

Go to the documentation of this file. 
  1. ACHSDNL1 ; IHS/ITSC/PMF - DENIAL LTR/FS (DRIVER) (2/6) ;  [ 10/31/2003  11:44 AM ]
  1.  ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**4,6,22**;JUNE 11, 2001;Build 13
  1.  ;ACHS*3.1*4  allow multiple office copies
  1.  ;ACHS*3.1*6 6.5.03 IHS/SET/FCJ NO LONGER WANT MANDATORY OFFICE COPY
  1.  ;
  1. START ;ENTRY POINT - TaskMan.  PRINT LETTERS AND FACT SHEETS.
  1.  S ACHSQUIT=0
  1.  D BRPT^ACHS
  1.  S ACHSBM=ACHSBM-4
  1.  W @IOF
  1.  I $G(ACHDBDT) S ACHDBDT=ACHDBDT-1
  1.  G:'ACHDBDT S3
  1. S1 ;
  1.  I $G(ACHDBDT) S ACHDBDT=$O(^ACHSDEN(DUZ(2),"D","AISSUE",ACHDBDT)) G END:'ACHDBDT!(ACHDBDT>ACHDEDT)!($G(ACHSQUIT))
  1.  S ACHSA=0
  1. S2 ;
  1.  S ACHSA=$O(^ACHSDEN(DUZ(2),"D","AISSUE",ACHDBDT,ACHSA))
  1.  G S1:+ACHSA=0
  1.  G S2:$$DN^ACHS(0,8)="Y"
  1.  G S2:$E($$DN^ACHS(0,1))="#"
  1.  ;
  1. S3 ;
  1.  S ACHDONE=""
  1.  ;ACHS*3.1*4  4/5/02  pmf  print 0 to 10 office copies
  1.  ;D ^ACHSDNL2 Q:$G(ACHSQUIT)  ; ACHS*3.1*4
  1.  ;ACHS*3.1*6 6.5.03 IHS/SET/FCJ NO LONGER WANT MANDATORY OFFICE COPY
  1.  ;S:'$G(ACHDCOFF) ACHDCOFF=1  ;ACHS*3.1*6 6.5.03
  1.  S:'$G(ACHDCOFF) ACHDCOFF=0   ;ACHS*3.1*6 6.5.03
  1.  F ACHSIII=1:1:ACHDCOFF D ^ACHSDNL2 Q:$G(ACHSQUIT)  ; ACHS*3.1*4
  1.  I $G(ACHSQUIT) Q  ; ACHS*3.1*4
  1.  S ACHDONE=1  ; ACHS*3.1*4
  1.  ;
  1.  I $D(ACHDPROZ) S ACHDCPAT=0
  1.  I ACHDCPAT>0 F ACHD("I")=1:1:ACHDCPAT D ^ACHSDNL2,CKPTR G:X=27!(X=U) END
  1.  S ACHD("CPAT")=ACHDCPAT
  1.  G:ACHDCVEN'>0 PRNTFACT
  1.  K ACHDCPAT
  1.  I $D(ACHDPROZ) G PROZ
  1.  S ACHDNAME=$P($G(^ACHSDEN(DUZ(2),"D",ACHSA,100)),U,3)
  1.  S ACHDADDR=$P($G(^ACHSDEN(DUZ(2),"D",ACHSA,100)),U,4,7)
  1.  S ACHSVPTR=""
  1.  S ACHDONFL=$S($$DN^ACHS(100,1)="Y":1,1:0)
  1.  ;
  1.  I ACHDONFL,$$DN^ACHS(100,2) D
  1.  .S ACHSVPTR=$$DN^ACHS(100,2)
  1.  .S ACHDNAME=$P($G(^AUTTVNDR(ACHSVPTR,0)),U)
  1.  ;
  1.  F ACHD("I")=1:1:ACHDCVEN D ^ACHSDNL2,CKPTR G:X=27!(X=U) END
  1.  ;
  1.  ;FIND ALL 'OTHER PROVIDER ON-FILE' ENTRIES
  1.  S ACHDNAME="",ACHDONFL=1
  1.  F ACHDVEND=0:0 S ACHDVEND=$O(^ACHSDEN(DUZ(2),"D",ACHSA,200,ACHDVEND)) Q:'ACHDVEND  D
  1.  .S ACHSVPTR=$P($G(^ACHSDEN(DUZ(2),"D",ACHSA,200,ACHDVEND,0)),U)
  1.  .S ACHDNAME=$P($G(^AUTTVNDR($P($G(^ACHSDEN(DUZ(2),"D",ACHSA,200,ACHDVEND,0)),U),0)),U) F ACHD("I")=1:1:ACHDCVEN D ^ACHSDNL2 Q:X=27!(X=U)
  1.  ;
  1.  ;FIND ALL 'OTHER PROVIDER (NOT ON-FILE)' ENTRIES
  1.  S ACHDONFL=0,ACHDNODE=210
  1.  F ACHDVEND=0:0 S ACHDVEND=$O(^ACHSDEN(DUZ(2),"D",ACHSA,210,ACHDVEND)) Q:'ACHDVEND  D
  1.  .S ACHDNAME=$P($G(^ACHSDEN(DUZ(2),"D",ACHSA,210,ACHDVEND,0)),U)
  1.  .S ACHDADDR=$P($G(^ACHSDEN(DUZ(2),"D",ACHSA,210,ACHDVEND,0)),U,2,5)
  1.  .F ACHD("I")=1:1:ACHDCVEN D ^ACHSDNL2 Q:X=27!(X=U)
  1.  ;
  1.  ;
  1. PRNTFACT ;
  1.  I ACHDCFAC F ACHD("I")=1:1:ACHDCFAC D ^ACHSDNL4,CKPTR G:X=27!(X=U) END
  1.  I ACHDBDT S ACHDCPAT=ACHD("CPAT") G S2
  1. END ;
  1.  K A,ACHDADDR,ACHDOC,ACHDOS,ACHDCFAC,ACHDCPAT,ACHDCVEN,ACHSA,ACHDISDT,ACHDNAME,ACHDNODE,ACHDRQDT,ACHDST,ACHDVEND,ACHDONFL
  1.  D ERPT^ACHS,END^ACHSDNL
  1.  Q
  1.  ;
  1. CKPTR ; --- Check if user pressed ESC
  1.  I $D(ZTSK) S X=0 Q
  1.  U IO(0)
  1.  R *X:0
  1.  I X'=27,(X'=U) U IO Q
  1.  W *7,*7,*7
  1.  F  R X:0 Q:'$T
  1.  W !!,"***   PRINTING INTERRUPTED   ***",!
  1.  S X=27
  1.  Q
  1.  ;
  1. PROZ ;
  1.  I $P(ACHDPROZ,U,2)'="Y" G PROZ1
  1.  S ACHSVPTR=$P(ACHDPROZ,U,3)
  1.  S ACHDONFL=1
  1.  S ACHDNAME=$P($G(^AUTTVNDR(ACHSVPTR,0)),U)
  1.  D ^ACHSDNL2
  1.  G PRNTFACT
  1.  ;
  1. PROZ1 ;
  1.  I $P(ACHDPROZ,U,2)'="N" Q
  1.  S ACHDONFL=0,ACHDVEND=$P(ACHDPROZ,U,3)
  1.  I 'ACHDVEND S ACHDNAME=$P(ACHDPROZ,U),ACHDADDR=$P($G(^ACHSDEN(DUZ(2),"D",ACHSA,100)),U,3,7) G PROZ2
  1.  S ACHDNAME=$P($G(^ACHSDEN(DUZ(2),"D",ACHSA,210,ACHDVEND,0)),U)
  1.  ;ACHS*3.1*22 ;CHANGED 3 TO 2 IN NXT LINE
  1.  S ACHDADDR=$P($G(^ACHSDEN(DUZ(2),"D",ACHSA,210,ACHDVEND,0)),U,2,7)
  1. PROZ2 ;
  1.  F ACHD("I")=1:1:ACHDCVEN D ^ACHSDNL2
  1.  G PRNTFACT
  1.  ;