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

RMPOBILU.m

Go to the documentation of this file.
  1. RMPOBILU ;EDS/MDB,RVD - HOME OXYGEN BILLING TRANSACTIONS ;8/7/98 10:58
  1. ;;3.0;PROSTHETICS;**29,43,44,77**;Feb 09, 1996
  1. ;RVD 3/18/03 patch #77 - don't allow future billing month creation
  1. ;
  1. Q
  1. VDRSCRN ; SCREEN
  1. Q
  1. I '$D(RMPOXITE) D Q
  1. . W !,$C(7)_"RMPOXITE NOT DEFINED!"
  1. . S DIC("S")="I 0"
  1. S DIC("S")="I $D(^RMPR(669.9,RMPOXITE,""RMPOVDR"",Y,0))"
  1. Q
  1. XFRM1 ; INPUT XFORM FOR BILLING MONTH, FILE 665.72
  1. S %DT(0)=-DT
  1. S %DT="E" D ^%DT S X=Y I Y<0 K X Q
  1. S (DINUM,X)=$E(X,1,5)_"00"
  1. Q
  1. 2319 ; -- Display 2319
  1. N RMPRNAM,RMPRDOB,RMPRSSN,RMPRDFN
  1. S (DFN,RMPRDFN)=RMPODFN D DEM^VADPT
  1. S RMPRNAM=VADM(1)
  1. S RMPRDOB=+VADM(3)
  1. S RMPRSSN=+VADM(2)
  1. S $P(RMPR("L"),"-",80)=""
  1. S RMPRBAC1=1
  1. D ^RMPRPAT
  1. K RMPRBAC1
  1. Q
  1. ACCEPT ; ACCEPT TRX
  1. D SAME S DR="2///Y" D ^DIE
  1. Q
  1. UNACCEPT ; UNACCEPT TRX
  1. D SAME S DR="2///N" D ^DIE
  1. Q
  1. SAME ;
  1. K DIE,DA,DR
  1. S DA=RMPODFN,DA(1)=RMPOVDR,DA(2)=RMPORVDT,DA(3)=RMPOXITE
  1. S DIE="^RMPO(665.72,"_DA(3)_",1,"_DA(2)_",1,"_DA(1)_",""V"","
  1. Q
  1. FCP(FCP) ;
  1. ;
  1. ; PASS:
  1. ; -- AS PARAMETER
  1. ; FCP = FREE-TEXT FUND CONTROL POINT NAME
  1. ; -- AS VARIABLES
  1. ; RMPOXITE = SITE #
  1. ; RMPODATE = BILLING MONTH
  1. ; RMPOVDR = VENDOR IEN (IF TYPE = 'PURCHASE CARD')
  1. ;
  1. ; RETURNS:
  1. ; TYPE ^ 442 IEN ^ REF # ^ AMOUNT ^ IEN
  1. ; TYPE = PAYMENT TYPE (1 = 1358, 'P' = PURCHASE CARD)
  1. ; 442 IEN = POINTER TO FILE 442, USED FOR POSTING
  1. ; REF # = C# FOR 1358, PCO# FOR PURCHASE CARD
  1. ; AMOUNT = TOTAL AMOUNT POSTED SO FAR (PURCHASE CARD ONLY)
  1. ; IEN = IEN OF 'FCP' RECORD IN FILE 665.72, USED FOR UPDATING TOTALS
  1. ;
  1. N FOUND,DATA,RVDT,IEN,TMP,SITE,FN,TYPE
  1. S QUIT=0,DATA="",FN=665.72
  1. I '$D(RMPOXITE) W !,"SITE NOT DEFINED!" Q -1
  1. I '$D(^RMPO(FN,RMPOXITE)) W !,"SITE NOT FOUND!" Q -1
  1. S SITE=RMPOXITE
  1. I '$D(RMPODATE) W !,"BILLING MONTH NOT DEFINED!" Q -1
  1. S RVDT=RMPODATE
  1. I '$D(^RMPO(FN,SITE,1,RVDT)) D Q -1
  1. . W !,"BILLING MONTH NOT DEFINED!"
  1. ;
  1. D FCP4 Q:FOUND DATA
  1. D FCP1 Q:(Y="")!$$QUIT -1
  1. S TYPE=Y
  1. D FCP2:TYPE=1,FCP3:TYPE="P" Q:($G(Y)<0)!QUIT -1
  1. Q DATA
  1. Q
  1. FCP4 ; LOOK FOR EXISTING PAYMENT TYPE
  1. S FOUND=0,DATA=""
  1. Q:'$D(^RMPO(FN,SITE,1,RVDT,2,"B",FCP))
  1. K DIC S DA(1)=RVDT,DA(2)=SITE
  1. S DIC("A")="Select Fund Control Point: "
  1. S DIC="^RMPO(FN,"_DA(2)_",1,"_DA(1)_",2,",DIC(0)="AMQEZ"
  1. S DIC("S")="S Z=^(0) I $P(Z,U)=FCP,$S($P(Z,U,2):1,($P(Z,U,2)=""P"")&"
  1. S DIC("S")=DIC("S")_"($P(Z,U,5)=DUZ)&($P(Z,U,6)=RMPOVDR):1,1:0),"
  1. S DIC("S")=DIC("S")_"$P(Z,U,8)="""""
  1. S DIC("W")="W ?35,$P(^(0),U,4)"
  1. S DIC("W")=DIC("W")_" I $P(^(0),U,2) W ?55,"
  1. S DIC("W")=DIC("W")_"$J($$BAL^RMPOPST1($P(^(0),U,3)),10,2)"
  1. D ^DIC
  1. Q:(Y<0)!$$QUIT
  1. K RMPOZ M RMPOZ=Y
  1. K DIR S DIR(0)="Y"
  1. S RMZ=^RMPO(FN,SITE,1,RVDT,2,+Y,0)
  1. S RMZ=$P(RMZ,U,4)
  1. S DIR("A")="Are you sure you want "_RMZ
  1. S DIR("B")="NO" D ^DIR G:(Y=0) FCP4 Q:(Y'=1)!$$QUIT
  1. K Y M Y=RMPOZ
  1. I $P(Y(0),U,2) S DATA=$P(Y(0),U,2,4)_U_U_(+Y),FOUND=1 Q
  1. S DATA=$P(Y(0),U,2)_U_$P(Y(0),U,3)_U
  1. S DATA=DATA_$P(Y(0),U,4)_U_$P(Y(0),U,7)_U_(+Y),FOUND=1
  1. Q
  1. FCP2 ; 1358
  1. S PRC("SITE")=RMPRS,PRC("CP")=FCP
  1. S PRCS("A")="Select Obligation Number: "
  1. D EN1A^PRCS58 Q:(Y<0)!$$QUIT
  1. K RMPOZ M RMPOZ=Y
  1. K DIR S DIR(0)="Y",DIR("B")="NO"
  1. S DIR("A")="Are you sure" D ^DIR Q:(Y<1)!$$QUIT
  1. K Y M Y=RMPOZ D FCPSET
  1. K PRC,PRCS
  1. Q
  1. FCPSET ; SET ENTRY IN RMPO
  1. S DATA=TYPE_U_$P(Y,U,1,2)_U_U ; SETUP RETURN VALUE
  1. ;Check if selected IFCAP order exist in file 665.72
  1. S Y=$$FCPCHK(.DATA) I Y Q
  1. K DIC,DIE,DA,DR,DD,DO
  1. S DA(2)=SITE,DA(1)=RVDT
  1. S DIC="^RMPO(665.72,"_DA(2)_",1,"_DA(1)_",2,"
  1. S DIC("P")=$P(^DD(665.723,2,0),U,2)
  1. S DIC(0)="L",X=FCP D FILE^DICN I Y<0 S DATA=-1 Q
  1. S DIE=DIC,DA=+Y,DATA=DATA_DA
  1. S DR="1////"_TYPE
  1. S DR=DR_";2////"_$P(DATA,U,2)
  1. S DR=DR_";3///"_$P(DATA,U,3)
  1. S DR=DR_";4////"_DUZ
  1. S:TYPE="P" DR=DR_";5////"_RMPOVDR
  1. D ^DIE
  1. S Z1=$P(DATA,U,2)
  1. S Z2=$P(DATA,U,3)
  1. S $P(^RMPO(665.72,DA(2),1,DA(1),2,DA,0),U,3,4)=Z1_U_Z2
  1. Q
  1. FCPCHK(DATA) ;CHECK IF FCP ALREADY EXIST IN FILE 665.72
  1. N IEN,FDT,FPT,FOUND
  1. S (IEN,FOUND)=0
  1. F S IEN=$O(^RMPO(FN,SITE,1,RVDT,2,"B",FCP,IEN)) Q:IEN="" D Q:FOUND
  1. . S FDT=^RMPO(FN,SITE,1,RVDT,2,IEN,0),FPT=$P(FDT,U,2)
  1. . I $P(FDT,U,8)>0 Q ; closed flag
  1. . I FPT=TYPE,$P(DATA,U,2)=$P(FDT,U,3),$P(DATA,U,3)=$P(FDT,U,4) D
  1. . . I TYPE=1 S DATA=DATA_IEN,FOUND=1 Q
  1. . . I $P(FDT,U,5)=DUZ,$P(FDT,U,6)=RMPOVDR D
  1. . . . S $P(DATA,U,4)=$P(FDT,U,7),DATA=DATA_IEN,FOUND=1
  1. Q FOUND
  1. FCP3 ; PURCHASE CARD
  1. N PRCA
  1. I '$D(^PRC(440.5,"H",DUZ)) D S Y=-1 Q
  1. . W !!,"You are not an authorized Purchase Card User, CONTACT FISCAL!"
  1. S PRCA=RMPRS_U_RMPOVDR
  1. D ADD^PRCH7D(.PRCA) S Y=PRCA Q:(Y<0)!(Y="^")!$$QUIT
  1. K RMPOZ M RMPOZ=Y
  1. K DIR S DIR(0)="Y",DIR("B")="NO",DIR("A")="Are you sure"
  1. D ^DIR Q:(Y<1)!$$QUIT
  1. K Y M Y=RMPOZ D FCPSET
  1. Q
  1. FCP1 ; PAYMENT TYPE
  1. K DIR,DA
  1. S DIR(0)="665.7232,1" D ^DIR
  1. Q
  1. GETFCP(DFCP) ; Return FCP from file 420 (External value only)
  1. ; Pass - DFCP = Default FCP [optional]
  1. ;
  1. N DIC,DA
  1. S:$D(DFCP) DIC("B")=DFCP
  1. S DA(1)=RMPOXITE,DIC("A")="Select FUND CONTROL POINT: "
  1. S DIC="^RMPR(669.9,"_DA(1)_",""RMPOFCP"",",DIC(0)="AEQMZ" D ^DIC
  1. I Y<0!$$QUIT Q Y
  1. Q Y_U_Y(0,0)
  1. QUIT() S QUIT=$D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q QUIT
  1. EQUIT() S QUIT=$D(DTOUT)!$D(Y) Q QUIT
  1. LJ(S,W,C) ; Left justify S in a field W wide padding with char F
  1. ;
  1. S C=$G(C," ") ; Default pad char is space
  1. S $P(S,C,W-$L(S)+$L(S,C))=""
  1. Q $E(S,1,W)
  1. Q
  1. ENC(X,X1,X2) ;Encrypt
  1. ;Variable X = string to encrypt
  1. ; X1 = DUZ
  1. ; X2 = FCP IEN of file 665.72
  1. D EN^XUSHSHP
  1. Q X
  1. DEC(X,X1,X2) ;Decrypt
  1. ;Variable X = encrypted string
  1. ; X1 = DUZ
  1. ; X2 = FCP IEN of file 665.72
  1. D DE^XUSHSHP
  1. Q X