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

ACHSHVT0.m

Go to the documentation of this file. 
  1. ACHSHVT0 ; IHS/ITSC/PMF - TRANSMIT MDO REPORTS TO HV PROVIDERS ;  [ 10/16/2001   8:16 AM ]
  1.  ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
  1.  ;
  1.  I '$D(^AUTTTEL(DUZ(2),2)) U IO(0) W *7,?10,"UNIX 3780 PORT NOT DEFINED FOR THIS FACILITY - CONTACT SITE MANAGER" G ABEND
  1.  S ACHSTTY=$P(^AUTTTEL(DUZ(2),2),U,1)
  1.  I $L(ACHSTTY)=1 S ACHSTTY="0"_ACHSTTY
  1.  D ^ACHSTUT2
  1. A0 ;
  1.  S ACHSZOPT=0,ACHSZFN=$$AOP^ACHS(2,1)_"achsm*"
  1.  D ARCHLIST^ACHSARCH
  1.  K ACHSFILE("N")
  1.  S ACHSR=""
  1. A1 ;
  1.  S ACHSR=$O(ACHSFILE(ACHSR))
  1.  G A5:+ACHSR=0
  1.  S ACHSN=$P($P(ACHSFILE(ACHSR),U,2),"/",5),ACHSN1=$E($P(ACHSN,".",1),7,8)
  1.  S X=$P(ACHSN,".",2),Y=$$GDT^ACHS(X),X=$$JTF^ACHS(X)
  1.  S ACHSXX=9999999-X,ACHSFILE("N",ACHSN1,ACHSXX,ACHSR)=ACHSN_U_Y
  1.  G A1
  1.  ;
  1. A5 ;
  1.  S ACHSR="",ACHSCT=0
  1.  K ACHSVAB
  1.  I $D(ACHSFILE("N")) G A6
  1.  W !!?10,"No High Volume Provider Reports Available for Transmission",!!
  1.  I $$DIR^XBDIR("E","Enter <RETURN> to Continue")
  1.  G EXIT
  1.  ;
  1. A6 ;
  1.  U IO(0)
  1.  W !,"High Volume Provider Reports Exist for the Following Facilities/Vendors: ",!
  1. A8 ;
  1.  S ACHSR=$O(ACHSFILE("N",ACHSR))
  1.  G A10:ACHSR=""
  1.  S Z=$O(^ACHSF("HVEA",ACHSR,"")),X=$O(^ACHSF("HVEA",ACHSR,Z,"")),(ACHSVPTR,Y)=$P(^ACHSF(Z,18,X,0),U,1),ACHSFN=$P(^AUTTVNDR(Y,0),U,1),ACHSN1=$P(^ACHSF(Z,18,X,0),U,2),ACHSCT=ACHSCT+1,ACHSVAB(ACHSCT)=ACHSN1
  1.  W !?10,$J(ACHSCT,3),"  ",ACHSFN
  1.  G A8
  1.  ;
  1. A10 ;
  1.  U IO(0)
  1.  S Y=$$DIR^XBDIR("N^1:"_ACHSCT,"Select Facility/Vendor (by number)","","","","",1)
  1.  I $D(DTOUT)!($D(DUOUT)) G EXIT
  1.  S ACHSV=ACHSVAB(Y)
  1.  K ACHSTXFN
  1. A15 ;
  1.  D SUBA11
  1.  U IO(0)
  1.  S Y=$$DIR^XBDIR("L^1:"_ACHSCT,"Enter Report #(s) to Transmit (eg 1,3,4 or 1-5):","","","","",1)
  1. A16 ;
  1.  F I=1:1:ACHSCT Q:$P(Y,",",I)=""  S Z=$P(Y,",",I),$P(ACHSTXFN(Z),U,2)="Y"
  1.  K ACHSTLST
  1.  S ACHSJ=0
  1.  F I=1:1:ACHSCT I $P(ACHSTXFN(I),U,2)="Y" S ACHSJ=ACHSJ+1,ACHSTLST(ACHSJ)=$P(ACHSTXFN(I),U,1)
  1.  D SUBA11
  1.  U IO(0)
  1.  W !!,"The Reports Selected Above will Now be Transmitted"
  1.  S Y=$$DIR^XBDIR("Y","Is This Correct? (Y/N)","N","","","",1)
  1.  I $D(DTOUT)!($D(DUOUT)) G EXIT
  1.  I +Y=0 G A6
  1. TXGEN ;
  1.  U IO(0)
  1.  W !
  1.  I $$DEL^%ZISH("/usr/spool/3780/","achshv.txname")
  1.  S ACHSZFN="/usr/spool/3780/achshv.txname"
  1.  I $$OPEN^%ZISH("/usr/spool/3780/","achshv.txname","W") S ACHSEMSG="M10" D ERROR^ACHSTCK1 G ABEND
  1.  S ACHSHFS1=IO,ACHSX=""
  1.  U ACHSHFS1
  1.  F ACHSI=1:1:ACHSJ D
  1.  . W ACHSTLST(ACHSI)," "
  1.  . S X=$P(ACHSTLST(ACHSI),".",2)
  1.  . W $$GDT^ACHS(X)," "
  1.  . S X=$E($P(ACHSTLST(ACHSI),".",1),6,6)
  1.  . W $S(X=0:"MDO",X=2:"DEN",1:" "),!
  1.  .Q
  1.  I $D(ACHSHFS1) S IO=ACHSHFS1,IONOFF="" D ^%ZISC
  1.  I $$DEL^%ZISH("/usr/spool/3780/","achshv.tx")
  1.  S ACHSZFN="/usr/spool/3780/achshv.tx"
  1.  I $$OPEN^%ZISH("/usr/spool/3780/","achshv.tx","W") S ACHSEMSG="M10" D ERROR^ACHSTCK1 G ABEND
  1.  S ACHSHFS1=IO
  1. B2A ;
  1.  S ACHSX=""
  1.  U ACHSHFS1
  1.  W "AN 90",!,"branch not OK to 500",!,"te /usr/spool/3780/achshv.txname",!,"branch not NRMEOF to 200",!
  1.  F I=1:1:ACHSJ W "te "_$$AOP^ACHS(2,1)_ACHSTLST(I),!,"branch not NRMEOF TO 200",!
  1.  W "vo",!,"qu",!,"200 vo",!,"qu 18",!,"500 vo",!,"qu 20",!
  1.  ;
  1.  S IO=ACHSHFS1,IONOFF=""
  1.  D ^%ZISC
  1. B3 ;
  1.  S ACHSHCMD="cd /usr/bin/3780;3780Plus -d /dev/tty"_ACHSTTY_" -c /usr/bin/3780/3780.cfgachs.s -j /usr/spool/3780/achshv.tx -b 4800"
  1.  ;
  1.  ;IHS/ITSC/PMF  1/12/01  replace call to vendor routine with call
  1.  ;to routine in our namespace
  1.  S ACHSRTCD=$$TERMINAL^ACHSHCMD(ACHSHCMD)
  1.  ;
  1.  I ACHSRTCD=0 G TXOK
  1.  ;
  1.  ;DOES THIS FUNCTION RETURN MORE THAN 1 AND 0 ?????
  1.  I ACHSRTCD=18 U IO(0) W !!,*7,?10,"3780 TRANSMISSION FAILURE -- CONTACT SITE MANAGER" G ABEND
  1.  I ACHSRTCD=20 U IO(0) W !!,*7,?10,"Auto-Answer Timeout Limit Reached - Transmission not Completed." G ABEND
  1. EXIT ;
  1.  D EN^XBVK("ACHS"),^ACHSVAR
  1.  K DIC,DIR,I,X,Y,Z
  1.  Q
  1.  ;
  1. TXOK ;
  1.  U IO(0)
  1.  W !!?10,"Transmission Successful"
  1.  G ABEND
  1.  ;
  1. ABEND ;
  1.  U IO(0)
  1.  I $$DIR^XBDIR("E","Enter <RETURN> to Continue")
  1.  G EXIT
  1.  ;
  1. SUBA11 ;
  1. A11 ;
  1.  S ACHSR="",ACHSCT=0
  1.  U IO(0)
  1.  W !!?10,"The Following Reports Are Available for Transmission to",!?25,$P(^AUTTVNDR(ACHSVPTR,0),U,1),!,$$REPEAT^XLFSTR("-",70),!,"Report #",?10,"Report Type",?30,"Report Date",?50,"File Name",?67,"TX",!,$$REPEAT^XLFSTR("-",70)
  1. A12 ;
  1.  S ACHSR=$O(ACHSFILE("N",ACHSV,ACHSR))
  1.  G A13:ACHSR=""
  1.  S X="",X=$O(ACHSFILE("N",ACHSV,ACHSR,X)),ACHSRXX=$E(ACHSFILE("N",ACHSV,ACHSR,X),6,6),ACHSRTYP=$S(ACHSRXX="0":"MAST DEL ORDER",ACHSRXX="2":"DENIAL LIST",1:" "),ACHSCT=ACHSCT+1,$P(ACHSTXFN(ACHSCT),U,1)=$P(ACHSFILE("N",ACHSV,ACHSR,X),U,1)
  1.  W !?5,ACHSCT,?10,ACHSRTYP,?30,$P(ACHSFILE("N",ACHSV,ACHSR,X),U,2),?50,$P(ACHSFILE("N",ACHSV,ACHSR,X),U,1),?68,$P(ACHSTXFN(ACHSCT),U,2)
  1.  G A12
  1.  ;
  1. A13 ;
  1.  Q
  1.  ;