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

ACHSPAC.m

Go to the documentation of this file. 
  1. ACHSPAC ; IHS/ITSC/JVK - VIEW/PRINT DOCUMENTS FOR A PATIENT ACC NO ;    [ 01/26/2005  10:53 PM ]
  1.  ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**12**;JUN 11, 2001
  1.  ;
  1.  ;12/4/00  pmf  add two lines for special pawnee benefit
  1.  ;1/4/04 ITSC/SET/JVK mod for special pawnee benefit
  1.  K A,DFN
  1.  I $P($G(^AUTTLOC(DUZ(2),0)),U,10)=505613 S ACHSYAYA=U_"AZO"_"PWN"_"LK" D @ACHSYAYA K ACHSYAYA Q:'$D(DFN)
  1.  ;
  1. PAT ;
  1.  ;ITSC/SET/JVK ACHS*3.1*12 FOR IHS/OKCAO/POC PAWNEE BEN PKG
  1.  I $P($G(^AUTTLOC(DUZ(2),0)),U,10)=505613 S ACHSYAYA=U_"AZO"_"PWN"_"LK" D @ACHSYAYA K ACHSYAYA Q:'$D(DFN)
  1.  ;D PTLK^ACHS
  1.  I $P($G(^AUTTLOC(DUZ(2),0)),U,10)'=505613 D PTLK^ACHS
  1.  I '$D(DFN) D K Q
  1.  I '$D(^ACHSF(DUZ(2),"PB",DFN)) W *7,!!,"This patient has no CHS documents on file.",! G PAT
  1.  S ACHSIO=IO
  1. BDT ;
  1.  S ACHSBDT=$$DATE^ACHS("B","DOCUMENTS FOR A PATIENT")
  1.  I ACHSBDT<1 D K Q
  1. EDT ;
  1.  S ACHSEDT=$$DATE^ACHS("E","DOCUMENTS FOR A PATIENT")
  1.  I ACHSEDT<1 D K Q
  1.  I $$EBB^ACHS(ACHSBDT,ACHSEDT) G BDT
  1. B ;
  1.  W !!,"TYPE of service:"
  1.  S ACHSTOS=$P(^DD(9002080.01,3,0),U,3)
  1.  F ACHS=1:1 S ACHS(ACHS)=$P(ACHSTOS,";",ACHS) Q:ACHS(ACHS)=""  W ?20,$P(ACHS(ACHS),":",1),"   ",$P(ACHS(ACHS),":",2),!
  1.  W !,"Select TYPE of service (1 - ",ACHS-1,"  'A' = 'ALL') ALL // "
  1.  D READ^ACHSFU
  1.  I $D(DTOUT) D K Q
  1.  G BDT:$D(DUOUT)
  1.  S:(Y="") Y="A"
  1.  G B3:Y="A"
  1.  I ($E(Y)="?")!(Y<1)!(Y>(ACHS-1)) W !!,"Enter an ""A"" to view documents for all types of service,",!,"otherwise, enter a number from 1 to ",ACHS-1,".",! G B
  1. B3 ;
  1.  S ACHSRPT=$S(Y="A":"ALL",1:+Y)
  1. DEV ;
  1.  S %ZIS="OPQ"
  1.  D ^%ZIS,SLV^ACHSFU:$D(IO("S"))
  1.  I POP D HOME^%ZIS D K Q
  1.  G:'$D(IO("Q")) START
  1.  K IO("Q")
  1.  I $D(IO("S"))!($E(IOST)'="P") W *7,!,"Please queue to system printers." D ^%ZISC G DEV
  1.  S ZTRTN="START^ACHSPDC",ZTDESC="CHS Patient "_ACHSRPT_" Summary, "_$$FMTE^XLFDT(ACHSBDT)_" to "_$$FMTE^XLFDT(ACHSEDT)_" for "_$P(^DPT(DFN,0),U)
  1.  F %="ACHSBDT","DFN","ACHSEDT","ACHSRPT" S ZTSAVE(%)=""
  1.  D ^%ZTLOAD
  1.  G:'$D(ZTSK) DEV
  1.  K ZTSK
  1.  D K
  1.  Q
  1.  ;
  1. START ;EP - From TaskMan.
  1.  D FC^ACHSUF
  1.  I $G(ACHSERR) D K Q
  1.  S (ACHSTOT,ACHSCANC,ACHSCTOT,ACHSTOT("$"),ACHSDOC)=0
  1.  S ACHST1=$$C^XBFUNC("PATIENT: "_$P($G(^DPT(DFN,0)),U)_"    CHART #: "_$$HRN^ACHS(DFN,DUZ(2)),80)
  1.  S ACHST2=$$C^XBFUNC("For the period "_$$FMTE^XLFDT(ACHSBDT)_" through "_$$FMTE^XLFDT(ACHSEDT),80)
  1.  S ACHSTOS=$P($G(^DD(9002080.01,3,0)),U,3)
  1.  S ACHSSTS=$P(^DD(9002080.01,11,0),U,3)
  1.  S ACHST3=$$C^XBFUNC($S(ACHSRPT:$P($P(ACHSTOS,";",ACHSRPT),":",2)_" documents ONLY",1:"All Documents"),80)
  1.  D BRPT^ACHSFU
  1.  X:$D(IO("S")) ACHSPPO
  1.  D HDR
  1.  K ACHSDVEW
  1.  S ACHSVQIT=0
  1.  S ACHSFAC=$P($G(^AUTTLOC($O(^AUTTLOC("B",DUZ(2),0)),0)),U,10)
  1. A ; Main loop.
  1.  S ACHSDOC=$O(^ACHSF(DUZ(2),"PB",DFN,ACHSDOC))
  1.  I ACHSDOC="" D END Q
  1.  S ACHSDOC0=$G(^ACHSF(DUZ(2),"D",ACHSDOC,0))
  1.  I ACHSDOC0="" W !!,"NO DOCUMENT ZERO NODE FOR X-REF PB FOR FACILITY: "_DUZ(2)_" DOCUMENT IEN: "_ACHSDOC_" PATIENT DFN: "_DFN W !!,"PLEASE NOTIFY YOUR SITE MANAGER IMMEDIATELY!!" W !! D RTRN^ACHS D K Q
  1.  G A:+$P(ACHSDOC0,U,2)<ACHSBDT,A:+$P(ACHSDOC0,U,2)>ACHSEDT,A:(ACHSRPT'="ALL")&(ACHSRPT'=$P(ACHSDOC0,U,4))
  1.  ;ITSC/SET/JVK ACHS*3.1*12
  1.  ;W $P(ACHSDOC0,U,14),ACHSFC,$P(ACHSDOC0,U)
  1.  W $P(ACHSDOC0,U,14),"-",$P(ACHSDOC0,U)
  1.  K Y
  1.  ;ITSC/SET/JVK ACHS*3.1*12
  1.  S ACHSPAC=$P($G(^ACHSF(DUZ(2),"D",ACHSDOC,1)),U,3)
  1.  W ?8,ACHSPAC
  1.  I $D(^ACHSF(DUZ(2),"D",ACHSDOC,3)),+$P($G(^ACHSF(DUZ(2),"D",ACHSDOC,3)),U)>0 S Y=+$P(^(3),U)
  1.  S:'$D(Y) Y=+$P(ACHSDOC0,U,2)
  1.  ;ITSC/SET/JVK ACHS*3.1*12
  1.  ;W ?17,$E(Y,2,7)
  1.  W ?24,$E(Y,4,5),"/",$E(Y,6,7),"/",$E(Y,2,3)
  1.  ;I $P(ACHSDOC0,U,8),$D(^AUTTVNDR($P(ACHSDOC0,U,8),0)) W ?24,$E($P(^(0),U),1,22)
  1.  I $P(ACHSDOC0,U,8),$D(^AUTTVNDR($P(ACHSDOC0,U,8),0)) W ?34,$E($P(^(0),U),1,22)
  1.  ;W ?47,$E($P($P(ACHSTOS,";",$P(ACHSDOC0,U,4)),":",2),1,2)
  1.  W ?58,$E($P($P(ACHSTOS,";",$P(ACHSDOC0,U,4)),":",2),1,2)
  1.  ;ITSC/SET/JVK ACHS*3.1*12 END OF CHANGES
  1.  I $D(^ACHSF(DUZ(2),"D",ACHSDOC,"PA")) S X=$S($D(^("ZA")):+^("ZA"),1:+^("PA")) G P6
  1.  S X=$S($D(^ACHSF(DUZ(2),"D",ACHSDOC,"PA")):+^("PA"),1:$P(ACHSDOC0,U,9))
  1.  I $P(ACHSDOC0,U,12)=4 S X=0,ACHS=$O(^ACHSF(DUZ(2),"D",ACHSDOC,"T",0)) F  Q:+ACHS=0  S X=+$P(^(ACHS,0),U,4),ACHS=$O(^ACHSF(DUZ(2),"D",ACHSDOC,"T",ACHS))
  1.  I $P(ACHSDOC0,U,12)=4 S ACHSCANC=ACHSCANC+X
  1. P6 ;
  1.  I $P(ACHSDOC0,U,12)]"" W ?61,$P($P(ACHSSTS,";",$P(ACHSDOC0,U,12)+1),":",2)
  1.  S ACHSTOT("$")=ACHSTOT("$")+X
  1.  S ACHSCTOT=ACHSTOT("$")-ACHSCANC
  1.  W ?66,$J($FN(X,",",2),12),!
  1.  I IOST["C-",$Y>24 G DISPLAY
  1.  I IOST'["C-",($Y>ACHSBM) D CPI^ACHS D RTRN^ACHS G K:$G(ACHSQUIT) D HDR
  1.  S ACHSTOT=ACHSTOT+1
  1.  G A
  1.  ;
  1. END ;
  1.  W ?69,"----------",!,"Total documents seen: ",$FN(ACHSTOT,","),?66,$J("$"_$FN(ACHSTOT("$"),",",2),12),!!?45,"LESS CANCELS",?66,$J($FN(-ACHSCANC,",P",2),13),!?69,"==========",!?66,$J("$"_$FN(ACHSCTOT,",",2),12)
  1.  I IOST["C-",$Y>15 S ACHSVQIT=1 D DISPLAY
  1.  D:IOST'["C-" CPI^ACHS
  1. K ;EP - Kill vars, do ERPT, quit.
  1.  K ACHSFAC,ACHSPPC,ACHSPPO,DFN,ACHSDOC0,ACHSDOC,ACHSSTS,ACHSTOS,ACHSTOT,ACHSDVEW,ACHSVQIT,ACHSCANC,ACHSCTOT
  1.  D ERPT^ACHS    ;CLOSES ALL DEVICES
  1.  Q
  1.  ;
  1. HDR ; Print header.
  1.  S ACHSPG=ACHSPG+1
  1.  W @IOF
  1.  D CPI^ACHS:IOST'["C-"
  1.  W !,$$REPEAT^XLFSTR("*",79),!,$$C^XBFUNC("CHS DOCUMENTS FOR A SPECIFIC PATIENT",80),!,ACHSUSR,?71,"Page",$J(ACHSPG,3),!,ACHST1,!,ACHST2,!,ACHST3,!,?34,$P(^DIC(4,DUZ(2),0),U),!,$$REPEAT^XLFSTR("*",79)
  1.  ;ITSC/SET/JVK ACHS*3.1*12
  1.  ;W !,"FAC",?7,"DOCUMENT",?17,"DATED",?24,"VENDOR",?47,"TYPE",?52,"STATUS",?69,"AMOUNT",!,$$REPEAT^XLFSTR("-",79),!
  1.  W !,"DOC #",?7,"ACC #",?24,"DATED",?34,"VENDOR",?55,"TYPE",?61,"STATUS",?69,"AMOUNT",!,$$REPEAT^XLFSTR("-",79),!
  1.  Q
  1.  ;
  1. DISPLAY ; View document selected from the report.
  1.  K DIR
  1.  S DIR(0)="Y",DIR("A")="Do you want to view one of the documents listed",DIR("B")="NO"
  1.  D ^DIR
  1.  K DIR
  1.  I Y=0,ACHSVQIT=0 D HDR S ACHSTOT=ACHSTOT+1 G A
  1.  I Y=0 Q
  1.  I ACHSVQIT=1,Y=0,ACHSPG>1,$Y>24 G AGAIN
  1.  S ACHSDVEW=0
  1.  D
  1.  . N DFN,ACHSDOC
  1.  . D ^ACHSAD
  1.  .Q
  1.  K DIR
  1.  S DIR(0)="E"
  1.  W !!
  1.  D ^DIR
  1.  G K:Y=0
  1.  I ACHSVQIT'=1 D HDR G A
  1. AGAIN ;
  1.  K DIR
  1.  S DIR(0)="Y",DIR("A")="View document list again",DIR("B")="NO"
  1.  W !!!
  1.  D ^DIR
  1.  I Y=1 S (ACHSCANC,ACHSVQIT,ACHSTOT,ACHSTOT("$"),ACHSPG)=0,ACHSDOC="" D HDR G A
  1.  G K
  1.  ;