RMPOPST2 ;EDS/JAM - HOME OXYGEN BILLING TRANSACTIONS/POSTING - SIGN OFF ;7/24/98
;;3.0;PROSTHETICS;**29,44**;Feb 09, 1996
;
;This subroutine is part of the billing module. Purchase Card
;orders are obligated and 1358 serivce orders are closed.
;The ^RMPO(665.72 global is updated with the date closed and user.
Q
MAIN ; Proper entry point
D HOME^%ZIS
S QUIT=0
D HOSITE^RMPOUTL0 Q:('$D(RMPOREC))!QUIT
S RMPOXITE=RMPOREC
D MONTH^RMPOBIL0() Q:'$D(RMPODATE)!QUIT
;D VENDOR^RMPOBIL0 Q:'$D(RMPOVDR)!QUIT
D SIGNOF,EXIT
Q
TEST ;set test data
S RMPOXITE=1,RMPORVDT=7019199,RMPOVDR=10,RMPODATE=2980800,DFNS(47)=""
S RMPO("STA")=521 N XQY0
S XQY0="RMPO BILLING TRANSACTIONS^Billing Transactions^^R^547^^^^^^^341^^^"
;
SIGNOF ;Sign off/close a FCP/purchase order
;Determine payment type;if PC obligate & close;if 1358 close
N SITE,RVDT,FIL,PFLG,FCPTOT,REFNO,IEN442,FCP,IENFCP,PAYTYP,LCK,X,Y
S FIL=665.72,SITE=RMPOXITE,RVDT=RMPODATE ;,VDR=RMPOVDR
D PTYP I Y<0!(Y="")!(Y="^") D ABORT Q
S PAYTYP=Y D FCP I Y'>0 D ABORT Q
S IENFCP=+Y,FCP=$P(Y(0),U),IEN442=$P(Y(0),U,3),REFNO=$P(Y(0),U,4)
S FCPTOT=$P(Y(0),U,7)
S PFLG=0 D FILCHK I PFLG D I 'Y D ABORT Q
. S DIR(0)="Y"
. S DIR("A")="All Records not posted for "_FCP_" Continue" D ^DIR
;Lock record at FCP level in ^RMPO(665.72
S LCK=$$FCPLCK^RMPOPST0 I 'LCK D Q
. W !!,"Record in Use. Try Later...."
D I 'Y D ABORT G UNLK ;verify user is ready to close FCP
. S DIR(0)="Y"
. S DIR("A")="Sure you want to Continue" D ^DIR
D @$S(PAYTYP:"FCPUPD",1:"PCSO")
;Unlock record at FCP in ^RMPO(665.72
UNLK D UNLKFCP^RMPOPST0
Q ;SIGNOF
;
ABORT ;Write abort message
W !!,"Process Aborted..."
Q
;
PTYP ;Select Payment Type; 1358 or purchase card
K DIC,DA,DR
D FCP1^RMPOBILU
Q ;PTYP
FCP ;Select Fund Control Point/Purchase Order to Sign Off
K DIC,DA,DR
S DA(1)=RVDT,DA(2)=SITE,DIC="^RMPO(665.72,"_DA(2)_",1,"_DA(1)_",2,"
S DIC(0)="QAEZ"
D
. I PAYTYP S DIC("S")="I $P(^(0),U,2)=PAYTYP,$P(^(0),U,8)=""""" Q
. ;S DIC("S")="I $P(^(0),U,2)=PAYTYP,$P(^(0),U,5)=DUZ,$P(^(0),U,6)=VDR,$P(^(0),U,8)="""""
. S DIC("S")="I $P(^(0),U,2)=PAYTYP,$P(^(0),U,5)=DUZ,$P(^(0),U,8)="""""
S DIC("W")="W ?35,$P(^(0),U,2),"
S DIC("W")=DIC("W")_"$P(^(0),U,4)"
D ^DIC
I Y<0 W " Nothing Found..."
Q ;FCP
FCPUPD ;Close FCP record in ^RMPO(665.72 file. Update global with date closed
;and user for 1358 purchase order
K DIE,DA,DR
D NOW^%DTC
S DA=IENFCP,DA(1)=RVDT,DA(2)=SITE
S DIE="^RMPO(665.72,"_DA(2)_",1,"_DA(1)_",2,"
S DR="4////"_DUZ_";"_"7///"_%
D ^DIE
Q ;FCPUPD
;
PCSO ;Obligate/Sign off PC order
N PRCA,PRCB,PRCC
S PRCA="",PRCB=IEN442
S PRCC=FCPTOT
D OBL^PRCH7D(.X,PRCA,PRCB,PRCC)
I X="^" D Q ;not obligated
. W !!,"Purchase Card Order "_REFNO
. W " Not Obligated for "_FCP
D FCPUPD
Q ;PCSO
;
FILCHK ;Check records to enure all posting done before obligating for a FCP
;PFLG 1-found record not posted, 0-all record posted
N DFN,IT,ITDT,VDR
W !!,"Verifying all items posted for FCP. Please be patient."
S VDR=0
F S VDR=$O(^RMPO(FIL,SITE,1,RVDT,1,VDR)) Q:'VDR D I PFLG Q
. S DFN=0
. F S DFN=$O(^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN)) Q:'DFN D I PFLG Q
. . I $P(^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN,0),U,3)="Y" Q
. . S IT=0
. . F S IT=$O(^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN,1,IT)) Q:'IT D Q:PFLG
. . . S ITDT=^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN,1,IT,0) W "."
. . . I $P(ITDT,U,3)=FCP D
. . . . I $P(ITDT,U,10)'="Y",$P(ITDT,U,6)'=$P(ITDT,U,11) S PFLG=1
Q ;FILCHK
EXIT ;Kill variables
K DA,DIC,DIR,RMPO,QUIT,X,Y,RMPODATE,RMPOMTH,RMPOREC,RMPORVDT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPOPST2 3653 printed Dec 13, 2024@02:31:25 Page 2
RMPOPST2 ;EDS/JAM - HOME OXYGEN BILLING TRANSACTIONS/POSTING - SIGN OFF ;7/24/98
+1 ;;3.0;PROSTHETICS;**29,44**;Feb 09, 1996
+2 ;
+3 ;This subroutine is part of the billing module. Purchase Card
+4 ;orders are obligated and 1358 serivce orders are closed.
+5 ;The ^RMPO(665.72 global is updated with the date closed and user.
+6 QUIT
MAIN ; Proper entry point
+1 DO HOME^%ZIS
+2 SET QUIT=0
+3 DO HOSITE^RMPOUTL0
if ('$DATA(RMPOREC))!QUIT
QUIT
+4 SET RMPOXITE=RMPOREC
+5 DO MONTH^RMPOBIL0()
if '$DATA(RMPODATE)!QUIT
QUIT
+6 ;D VENDOR^RMPOBIL0 Q:'$D(RMPOVDR)!QUIT
+7 DO SIGNOF
DO EXIT
+8 QUIT
TEST ;set test data
+1 SET RMPOXITE=1
SET RMPORVDT=7019199
SET RMPOVDR=10
SET RMPODATE=2980800
SET DFNS(47)=""
+2 SET RMPO("STA")=521
NEW XQY0
+3 SET XQY0="RMPO BILLING TRANSACTIONS^Billing Transactions^^R^547^^^^^^^341^^^"
+4 ;
SIGNOF ;Sign off/close a FCP/purchase order
+1 ;Determine payment type;if PC obligate & close;if 1358 close
+2 NEW SITE,RVDT,FIL,PFLG,FCPTOT,REFNO,IEN442,FCP,IENFCP,PAYTYP,LCK,X,Y
+3 ;,VDR=RMPOVDR
SET FIL=665.72
SET SITE=RMPOXITE
SET RVDT=RMPODATE
+4 DO PTYP
IF Y<0!(Y="")!(Y="^")
DO ABORT
QUIT
+5 SET PAYTYP=Y
DO FCP
IF Y'>0
DO ABORT
QUIT
+6 SET IENFCP=+Y
SET FCP=$PIECE(Y(0),U)
SET IEN442=$PIECE(Y(0),U,3)
SET REFNO=$PIECE(Y(0),U,4)
+7 SET FCPTOT=$PIECE(Y(0),U,7)
+8 SET PFLG=0
DO FILCHK
IF PFLG
Begin DoDot:1
+9 SET DIR(0)="Y"
+10 SET DIR("A")="All Records not posted for "_FCP_" Continue"
DO ^DIR
End DoDot:1
IF 'Y
DO ABORT
QUIT
+11 ;Lock record at FCP level in ^RMPO(665.72
+12 SET LCK=$$FCPLCK^RMPOPST0
IF 'LCK
Begin DoDot:1
+13 WRITE !!,"Record in Use. Try Later...."
End DoDot:1
QUIT
+14 ;verify user is ready to close FCP
Begin DoDot:1
+15 SET DIR(0)="Y"
+16 SET DIR("A")="Sure you want to Continue"
DO ^DIR
End DoDot:1
IF 'Y
DO ABORT
GOTO UNLK
+17 DO @$SELECT(PAYTYP:"FCPUPD",1:"PCSO")
+18 ;Unlock record at FCP in ^RMPO(665.72
UNLK DO UNLKFCP^RMPOPST0
+1 ;SIGNOF
QUIT
+2 ;
ABORT ;Write abort message
+1 WRITE !!,"Process Aborted..."
+2 QUIT
+3 ;
PTYP ;Select Payment Type; 1358 or purchase card
+1 KILL DIC,DA,DR
+2 DO FCP1^RMPOBILU
+3 ;PTYP
QUIT
FCP ;Select Fund Control Point/Purchase Order to Sign Off
+1 KILL DIC,DA,DR
+2 SET DA(1)=RVDT
SET DA(2)=SITE
SET DIC="^RMPO(665.72,"_DA(2)_",1,"_DA(1)_",2,"
+3 SET DIC(0)="QAEZ"
+4 Begin DoDot:1
+5 IF PAYTYP
SET DIC("S")="I $P(^(0),U,2)=PAYTYP,$P(^(0),U,8)="""""
QUIT
+6 ;S DIC("S")="I $P(^(0),U,2)=PAYTYP,$P(^(0),U,5)=DUZ,$P(^(0),U,6)=VDR,$P(^(0),U,8)="""""
+7 SET DIC("S")="I $P(^(0),U,2)=PAYTYP,$P(^(0),U,5)=DUZ,$P(^(0),U,8)="""""
End DoDot:1
+8 SET DIC("W")="W ?35,$P(^(0),U,2),"
+9 SET DIC("W")=DIC("W")_"$P(^(0),U,4)"
+10 DO ^DIC
+11 IF Y<0
WRITE " Nothing Found..."
+12 ;FCP
QUIT
FCPUPD ;Close FCP record in ^RMPO(665.72 file. Update global with date closed
+1 ;and user for 1358 purchase order
+2 KILL DIE,DA,DR
+3 DO NOW^%DTC
+4 SET DA=IENFCP
SET DA(1)=RVDT
SET DA(2)=SITE
+5 SET DIE="^RMPO(665.72,"_DA(2)_",1,"_DA(1)_",2,"
+6 SET DR="4////"_DUZ_";"_"7///"_%
+7 DO ^DIE
+8 ;FCPUPD
QUIT
+9 ;
PCSO ;Obligate/Sign off PC order
+1 NEW PRCA,PRCB,PRCC
+2 SET PRCA=""
SET PRCB=IEN442
+3 SET PRCC=FCPTOT
+4 DO OBL^PRCH7D(.X,PRCA,PRCB,PRCC)
+5 ;not obligated
IF X="^"
Begin DoDot:1
+6 WRITE !!,"Purchase Card Order "_REFNO
+7 WRITE " Not Obligated for "_FCP
End DoDot:1
QUIT
+8 DO FCPUPD
+9 ;PCSO
QUIT
+10 ;
FILCHK ;Check records to enure all posting done before obligating for a FCP
+1 ;PFLG 1-found record not posted, 0-all record posted
+2 NEW DFN,IT,ITDT,VDR
+3 WRITE !!,"Verifying all items posted for FCP. Please be patient."
+4 SET VDR=0
+5 FOR
SET VDR=$ORDER(^RMPO(FIL,SITE,1,RVDT,1,VDR))
if 'VDR
QUIT
Begin DoDot:1
+6 SET DFN=0
+7 FOR
SET DFN=$ORDER(^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN))
if 'DFN
QUIT
Begin DoDot:2
+8 IF $PIECE(^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN,0),U,3)="Y"
QUIT
+9 SET IT=0
+10 FOR
SET IT=$ORDER(^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN,1,IT))
if 'IT
QUIT
Begin DoDot:3
+11 SET ITDT=^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN,1,IT,0)
WRITE "."
+12 IF $PIECE(ITDT,U,3)=FCP
Begin DoDot:4
+13 IF $PIECE(ITDT,U,10)'="Y"
IF $PIECE(ITDT,U,6)'=$PIECE(ITDT,U,11)
SET PFLG=1
End DoDot:4
End DoDot:3
if PFLG
QUIT
End DoDot:2
IF PFLG
QUIT
End DoDot:1
IF PFLG
QUIT
+14 ;FILCHK
QUIT
EXIT ;Kill variables
+1 KILL DA,DIC,DIR,RMPO,QUIT,X,Y,RMPODATE,RMPOMTH,RMPOREC,RMPORVDT
+2 QUIT
