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

BMCVURT.m

Go to the documentation of this file.
  1. BMCVURT ; IHS/OIT/FCJ - SELECT/DISPLAY RATE QUOTATIONS ;
  1. ;;4.0;REFERRED CARE INFO SYSTEM;**5**;JAN 09, 2006;Build 101
  1. ;BMC*4.0*5 IHS.OIT.FCJ ORIGIAL ROUTINE FR ACHSURT
  1. ;
  1. A1 ;EP
  1. S BMCI=""
  1. S:'$D(BMCCTNA) BMCCTNA=0
  1. A1A ;
  1. S BMCI=$O(^AUTTVNDR(BMCPROV,18,"AGR",BMCI))
  1. Q:BMCI=""
  1. S BMCJ=""
  1. A1C ;
  1. S BMCJ=$O(^AUTTVNDR(BMCPROV,18,"AGR",BMCI,BMCJ))
  1. G A1A:BMCJ=""
  1. S X=$G(^AUTTVNDR(BMCPROV,18,BMCJ,0)) ;GET 'AGREEMENT/RATE/BPA NUMBER NODE
  1. S:'$D(BMCRT(BMCI)) BMCRT(BMCI)=0
  1. S BMCRT(BMCI)=BMCRT(BMCI)+1
  1. ;
  1. ;IF 'EFFECTIVE DATE' > EST. DATE OF SERVICE
  1. ;OR EST. DATE OF SERVICE > 'EXPIRATION DATE'
  1. I ($P(X,U,8)>BMCEDOS)!(BMCEDOS>$P(X,U,9)) G A1C
  1. A1D ;
  1. S BMCCTNA=BMCCTNA+1
  1. S BMCRT(BMCCTNA)=X
  1. S:'$D(BMCRT(BMCI,"ACTIVE")) BMCRT(BMCI,"ACTIVE")=0
  1. S BMCRT(BMCI,"ACTIVE")=$G(BMCRT(BMCI,"ACTIVE"))+1
  1. S:'$D(BMCRT(0,"ACTIVE")) BMCRT(0,"ACTIVE")=0
  1. S BMCRT(0,"ACTIVE")=BMCRT(0,"ACTIVE")+1
  1. S BMCRT(BMCI)=$G(BMCRT(BMCI))+1
  1. S X=$P(BMCRT(BMCCTNA),U,6),Y=$E(X,4,5)_"-"_$E(X,6,7)_"-"_$E(X,2,3),$P(BMCRT(BMCCTNA),U,6)=Y
  1. S X=$P(BMCRT(BMCCTNA),U,8),Y=$E(X,4,5)_"-"_$E(X,6,7)_"-"_$E(X,2,3),$P(BMCRT(BMCCTNA),U,8)=Y
  1. S X=$P(BMCRT(BMCCTNA),U,9),Y=$E(X,4,5)_"-"_$E(X,6,7)_"-"_$E(X,2,3),$P(BMCRT(BMCCTNA),U,9)=Y
  1. S $P(BMCRT(BMCCTNA),U,11)=BMCJ
  1. G A1C
  1. ;
  1. A2 ;EP
  1. I BMCCTNA=1 S BMCAGRN=1,BMCAGRP=$P(BMCRT(BMCCTNA),U,11) G A2A
  1. G A3:'BMCAGRN
  1. A2A ;
  1. W !!,"Enter Corresponding CONTRACT, AGREEMENT OR RATE QUOTE #. "
  1. I BMCAGRN,$D(BMCRT(BMCAGRN)) S BMCI=BMCAGRN,BMCJ=$P(BMCRT(BMCAGRN),U,10) D NODISP W Y,"// "
  1. D READ^BMC
  1. G:(Y?1"?".E)!(Y="?") A3
  1. I Y="@" S (BMCAGRN,BMCAGRP)="" W " DELETED" Q
  1. S Y=$E(Y)
  1. Q:$D(DUOUT)!$D(DTOUT)!(Y="")
  1. I (Y>BMCCTNA)!(Y<1) W !!,"Please enter 1 thru "_BMCCTNA_" " G A2A
  1. S BMCAGRN=+Y,BMCAGRP=$P(BMCRT(+Y),U,11),BMCCONP=""
  1. S:$P(BMCRT(+Y),U,10)="CNT" BMCCONP=BMCAGRP,BMCAGRP=""
  1. G A2A
  1. ;
  1. A3 ;
  1. D HDR:'$D(BMCAHDR)
  1. S BMCI=C
  1. I BMCCTNA>C S BMCI=0
  1. A3B ;
  1. S BMCI=$O(BMCRT(BMCI))
  1. G A2A:+BMCI=0
  1. S BMCJ=$P(BMCRT(BMCI),U,10)
  1. W !,$J(BMCI,2),?3,BMCJ
  1. D NODISP ;BPA AGREEMENT NUMBER DISPLAY
  1. W ?9,Y
  1. A3C ;
  1. W ?20,$P(BMCRT(BMCI),U,8),?30,$P(BMCRT(BMCI),U,9)
  1. I BMCJ="CNT" W ?45,$P(BMCRT(BMCI),U,2),! G A3B
  1. S X=$P(BMCRT(BMCI),U,4)
  1. I X="",($P(BMCRT(BMCI),U,2)="") G A3D
  1. S Y=$S(X="Y":"YES",X="N":" NO",1:" ")
  1. I Y=" ",$P(BMCRT(BMCI),U,2)="" G A3D
  1. S Y=Y_" INP: "
  1. S:$P(BMCRT(BMCI),U,2)'="" Y=Y_$P(BMCRT(BMCI),U,2)
  1. W ?40,Y,!
  1. A3D ;
  1. S X=$P(BMCRT(BMCI),U,5)
  1. I X=""&($P(BMCRT(BMCI),U,3)="") G A3E
  1. S Y=$S(X="Y":"YES",X="N":" NO",1:" ")
  1. I Y=" ",$P(BMCRT(BMCI),U,3)="" G A3E
  1. S Y=Y_" OUT: "
  1. S:$P(BMCRT(BMCI),U,3)'="" Y=Y_$P(BMCRT(BMCI),U,3)
  1. W ?40,Y,!
  1. A3E ;
  1. W:$P(BMCRT(BMCI),U,7)'="" ?45,"PRO: ",$P(BMCRT(BMCI),U,7),!
  1. G A3B
  1. ;
  1. EXIT ;
  1. K Y,X,BMCCT
  1. Q
  1. ;
  1. HDR ;
  1. W !!," #",?3,"Type",?9,"Number",?20,"Eff-Date",?30,"Exp-Date",?40,"MCR",?45,"Description",!?3,"----",?9,"---------",?20,"--------",?30,"--------",?40,"---",?45,"----------------------------"
  1. Q
  1. ;
  1. NODISP ;DISPLAY BPA AGREEMENT STUFF
  1. S Y=""
  1. I BMCJ="CNT" S Y=$P(BMCRT(BMCI),U) Q
  1. S Y=$E($P(BMCRT(BMCI),U),1,2)_$S(BMCJ="BPA":"-A-",BMCJ="PA":"-PA-",BMCJ="RQ":"-R-",1:"")
  1. S X=$E($P(BMCRT(BMCI),U),3,6)
  1. I BMCJ="PA" S Y=Y_$E(X,2,4) Q
  1. S Y=Y_$E(X,1,4)
  1. Q
  1. ;