ACHSPA ; IHS/ITSC/PMF - DOCUMENT PAYMENT - DRIVER ; [ 08/30/2004 2:28 PM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**4,5,11**;JUN 11, 2001
;3.1*4 loop through payment prompts until the user is done
;3.1*11 8.30.04 IHS/ITSC/FCJ TEST FOR LOCK OF NODE
;
A1 ;
K ACHSBLKF,^UTILITY($J)
;
;CHECK IF THE REGISTER IS CLOSED HASN'T THIS BEEN DONE BEFORE?????
;
;The purpose of so many checks on the register is that once the
;register is closed, there can be no more money recording for the
;day. So each function that might change the amount of money
;owed or paid is blocked this way.
;
I $D(^ACHS(9,DUZ(2),"FY",ACHSCFY,"W",+ACHSFYWK(DUZ(2),ACHSCFY),0)),$P(^(0),U,2)=DT W !!,*7," The Register Has Been CLOSED -- Document Payment is cancelled.",!,"Please advise your supervisor!" I $$DIR^XBDIR("E","Press RETURN...") D END Q
;
;ACHS*3.1*4 3/29/02 pmf add a loop here so that we continue
; prompting until they are done
N STOP S STOP=0 F D A2 Q:STOP ; ACHS*3.1*4
Q ; ACHS*3.1*4
;
;
A2 ;
D ^ACHSUSC ;DISPLAY DOCUMENT CANCEL/SUPPLEMENTAL INFO
;
I '$D(ACHSDIEN) D END Q
I $D(DTOUT) D END Q
I $D(DUOUT) K DUOUT Q
;
I $D(^ACHSF(DUZ(2),"D",ACHSDIEN,"PA")) W *7,!,"PAYMENT HAS ALREADY BEEN ENTERED.",!,"TRY ADJUSTMENT OPTION",!,"PAD Payment Adjustment",!,"UNDER THE FACILITY MANAGEMENT MENU" G A2
;
K ACHSBLKF,ACHSISAO
;
A3 ;EP - For automatic EOBR processing.
K ACHSSET
S ACHSX=+$P(^ACHSF(DUZ(2),"D",ACHSDIEN,0),U,14) ;FISCAL YEAR
D FYCVT^ACHSFU ;COMPUTE ACTUAL
;FISCAL YEAR
S ACHSACFY=ACHSY,ACHSACWK=+ACHSFYWK(DUZ(2),ACHSACFY)
;
D CKB^ACHSUUP ;CHECK DCR BALANCE
;VS. TOTAL OBLIGATED FYTD
;
;IF REGS BALANCE OUT AND IS AREA OFFICE ERROR=REGISTERS OUT OF BAL;E
I $D(ACHSCNC),$D(ACHSISAO) S ACHSERRE=13,ACHSEDAT="" D ^ACHSEOBG S ACHSERRA=1
;
I $D(ACHSCNC) D END Q ;REGISTERS OUT OF BALANCE
;
D SBTRN^ACHSPA0 ;SET NEW TRANS NODE, GET MAX, PAYMENTS ETC
I $D(DUOUT) D END Q ;ACHS*3.1*11 8.30.04 IHS/ITSC/FCJ TEST FOR LOCK OF NODE
;
D ^ACHSPAZ:'$D(ACHSISAO) ;ENTER SVDT,WKLD,FULP,3RDP,VAMT
;
I $D(DTOUT) D END Q
;
;ACHS*3.1*4 3/29/02 pmf no more GOing to the top.
;I $D(DUOUT)!'$D(ACHSSET),'$D(ACHSISAO) LOCK G A1 ; ACHS*3.1*4
;I $D(DUOUT)!'$D(ACHSSET),'$D(ACHSISAO) L Q ; ACHS*3.1*4
I $D(DUOUT)!'$D(ACHSSET),'$D(ACHSISAO) LOCK Q ;IHS/SET/GTH ACHS*3.1*5 12/06/2002
;
I '$D(ACHSBLKF) D A6 Q ;BYPASS INTERACTIVE
I $D(ACHSISAO) D A6 Q ;BYPASS INTERACTIVE
;
;ACHS*3.1*4 3/29/02 pmf no more GOing to the top. one
; line changed, one line removed
;I '$D(ACHSISAO) D A6 W !! G A1 ; ACHS*3.1*4
I '$D(ACHSISAO) D A6 Q ; ACHS*3.1*4
;G A1 ; ACHS*3.1*4
Q
;
A6 ;
;
D ^ACHSPA0 ;DOCUMENT PAYMENT CONTINUED
;
D ENTER^ACHSPAM:'$D(ACHSISAO)&'$D(ACHSBLKF) ;DOCUMENT PAYMENT
;ENTER/EDIT MEDICAL DATA
LOCK ;UNLOCK ALL LOCKS THAT WE MAY HAVE FORGOT
;
;IF 'PRINT SUPPLEMENT DOCUMENTS' GO Update the P.O. document status
;in the RCIS REFERRAL file
I $$DOC^ACHS(2,7) S ACHSREF=$$DOC^ACHS(2,7) D AUTH^ACHSBMC K ACHSREF
I '$D(ACHSISAO) Q ;W !! G A1 ;IF NOT AREA OFFIC
;
END ;
LOCK
K ACHSADDT,ACHSCONP,ACHSCAN,ACHSDIDT,ACHSDITY,ACHSDRG,ACHSSCC,ACHSCOPT,ACHSESDA,ACHSESDO,ACHSFDT,ACHSTDT,ACHSHON,ACHSORDN,ACHSBLKF,ACHSIPA,ACHSPROV,ACHSSIG,ACHSSVDT,ACHSWKLD,ACHSFULP,ACHS3RDP,ACHS3RDS,ACHSUSE,X,X1,X2
K ACHSADJ
I '$D(ACHSISAO) K ACHSDERR,ACHSEOBR,ACHSTDA,^UTILITY($J)
;
; ACHS*3.1*4 3/29/02 pmf add STOP var
I $D(STOP) S STOP=1 ; ACHS*3.1*4
;
Q
;
ACHSPA ; IHS/ITSC/PMF - DOCUMENT PAYMENT - DRIVER ; [ 08/30/2004 2:28 PM ]
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**4,5,11**;JUN 11, 2001
+2 ;3.1*4 loop through payment prompts until the user is done
+3 ;3.1*11 8.30.04 IHS/ITSC/FCJ TEST FOR LOCK OF NODE
+4 ;
A1 ;
+1 KILL ACHSBLKF,^UTILITY($JOB)
+2 ;
+3 ;CHECK IF THE REGISTER IS CLOSED HASN'T THIS BEEN DONE BEFORE?????
+4 ;
+5 ;The purpose of so many checks on the register is that once the
+6 ;register is closed, there can be no more money recording for the
+7 ;day. So each function that might change the amount of money
+8 ;owed or paid is blocked this way.
+9 ;
+10 IF $DATA(^ACHS(9,DUZ(2),"FY",ACHSCFY,"W",+ACHSFYWK(DUZ(2),ACHSCFY),0))
IF $PIECE(^(0),U,2)=DT
WRITE !!,*7," The Register Has Been CLOSED -- Document Payment is cancelled.",!,"Please advise your supervisor!"
IF $$DIR^XBDIR("E","Press RETURN...")
DO END
QUIT
+11 ;
+12 ;ACHS*3.1*4 3/29/02 pmf add a loop here so that we continue
+13 ; prompting until they are done
+14 ; ACHS*3.1*4
NEW STOP
SET STOP=0
FOR
DO A2
IF STOP
QUIT
+15 ; ACHS*3.1*4
QUIT
+16 ;
+17 ;
A2 ;
+1 ;DISPLAY DOCUMENT CANCEL/SUPPLEMENTAL INFO
DO ^ACHSUSC
+2 ;
+3 IF '$DATA(ACHSDIEN)
DO END
QUIT
+4 IF $DATA(DTOUT)
DO END
QUIT
+5 IF $DATA(DUOUT)
KILL DUOUT
QUIT
+6 ;
+7 IF $DATA(^ACHSF(DUZ(2),"D",ACHSDIEN,"PA"))
WRITE *7,!,"PAYMENT HAS ALREADY BEEN ENTERED.",!,"TRY ADJUSTMENT OPTION",!,"PAD Payment Adjustment",!,"UNDER THE FACILITY MANAGEMENT MENU"
GOTO A2
+8 ;
+9 KILL ACHSBLKF,ACHSISAO
+10 ;
A3 ;EP - For automatic EOBR processing.
+1 KILL ACHSSET
+2 ;FISCAL YEAR
SET ACHSX=+$PIECE(^ACHSF(DUZ(2),"D",ACHSDIEN,0),U,14)
+3 ;COMPUTE ACTUAL
DO FYCVT^ACHSFU
+4 ;FISCAL YEAR
+5 SET ACHSACFY=ACHSY
SET ACHSACWK=+ACHSFYWK(DUZ(2),ACHSACFY)
+6 ;
+7 ;CHECK DCR BALANCE
DO CKB^ACHSUUP
+8 ;VS. TOTAL OBLIGATED FYTD
+9 ;
+10 ;IF REGS BALANCE OUT AND IS AREA OFFICE ERROR=REGISTERS OUT OF BAL;E
+11 IF $DATA(ACHSCNC)
IF $DATA(ACHSISAO)
SET ACHSERRE=13
SET ACHSEDAT=""
DO ^ACHSEOBG
SET ACHSERRA=1
+12 ;
+13 ;REGISTERS OUT OF BALANCE
IF $DATA(ACHSCNC)
DO END
QUIT
+14 ;
+15 ;SET NEW TRANS NODE, GET MAX, PAYMENTS ETC
DO SBTRN^ACHSPA0
+16 ;ACHS*3.1*11 8.30.04 IHS/ITSC/FCJ TEST FOR LOCK OF NODE
IF $DATA(DUOUT)
DO END
QUIT
+17 ;
+18 ;ENTER SVDT,WKLD,FULP,3RDP,VAMT
IF '$DATA(ACHSISAO)
DO ^ACHSPAZ
+19 ;
+20 IF $DATA(DTOUT)
DO END
QUIT
+21 ;
+22 ;ACHS*3.1*4 3/29/02 pmf no more GOing to the top.
+23 ;I $D(DUOUT)!'$D(ACHSSET),'$D(ACHSISAO) LOCK G A1 ; ACHS*3.1*4
+24 ;I $D(DUOUT)!'$D(ACHSSET),'$D(ACHSISAO) L Q ; ACHS*3.1*4
+25 ;IHS/SET/GTH ACHS*3.1*5 12/06/2002
IF $DATA(DUOUT)!'$DATA(ACHSSET)
IF '$DATA(ACHSISAO)
LOCK
QUIT
+26 ;
+27 ;BYPASS INTERACTIVE
IF '$DATA(ACHSBLKF)
DO A6
QUIT
+28 ;BYPASS INTERACTIVE
IF $DATA(ACHSISAO)
DO A6
QUIT
+29 ;
+30 ;ACHS*3.1*4 3/29/02 pmf no more GOing to the top. one
+31 ; line changed, one line removed
+32 ;I '$D(ACHSISAO) D A6 W !! G A1 ; ACHS*3.1*4
+33 ; ACHS*3.1*4
IF '$DATA(ACHSISAO)
DO A6
QUIT
+34 ;G A1 ; ACHS*3.1*4
+35 QUIT
+36 ;
A6 ;
+1 ;
+2 ;DOCUMENT PAYMENT CONTINUED
DO ^ACHSPA0
+3 ;
+4 ;DOCUMENT PAYMENT
IF '$DATA(ACHSISAO)&'$DATA(ACHSBLKF)
DO ENTER^ACHSPAM
+5 ;ENTER/EDIT MEDICAL DATA
+6 ;UNLOCK ALL LOCKS THAT WE MAY HAVE FORGOT
LOCK
+7 ;
+8 ;IF 'PRINT SUPPLEMENT DOCUMENTS' GO Update the P.O. document status
+9 ;in the RCIS REFERRAL file
+10 IF $$DOC^ACHS(2,7)
SET ACHSREF=$$DOC^ACHS(2,7)
DO AUTH^ACHSBMC
KILL ACHSREF
+11 ;W !! G A1 ;IF NOT AREA OFFIC
IF '$DATA(ACHSISAO)
QUIT
+12 ;
END ;
+1 LOCK
+2 KILL ACHSADDT,ACHSCONP,ACHSCAN,ACHSDIDT,ACHSDITY,ACHSDRG,ACHSSCC,ACHSCOPT,ACHSESDA,ACHSESDO,ACHSFDT,ACHSTDT,ACHSHON,ACHSORDN,ACHSBLKF,ACHSIPA,ACHSPROV,ACHSSIG,ACHSSVDT,ACHSWKLD,ACHSFULP,ACHS3RDP,ACHS3RDS,ACHSUSE,X,X1,X2
+3 KILL ACHSADJ
+4 IF '$DATA(ACHSISAO)
KILL ACHSDERR,ACHSEOBR,ACHSTDA,^UTILITY($JOB)
+5 ;
+6 ; ACHS*3.1*4 3/29/02 pmf add STOP var
+7 ; ACHS*3.1*4
IF $DATA(STOP)
SET STOP=1
+8 ;
+9 QUIT
+10 ;
