ACHSVPT ; IHS/ITSC/PMF - UPDATE VENDOR PAYMENTS FILE ; [ 10/16/2001 8:16 AM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
;
;CALLED FROM
;ACHSAJ1+146
;ACHSPA0+72
;
;INPUT IS ACHSDAP ;AMOUNT TO BE ADDED TO
;
;CHS VENDOR PAYMENTS^9002075
;
;IF FACILITY ENTRY NOT THERE CREATE NEW ONE
;AGAIN A CASE WHERE FILEMAN SHOULD HANDLE THIS
I '$D(^ACHSVPMT(DUZ(2))) D
.S $P(^ACHSVPMT(DUZ(2),0),U)=DUZ(2)
.S ^ACHSVPMT("B",DUZ(2),DUZ(2))=""
.S $P(^ACHSVPMT(0),U,3)=DUZ(2),$P(^(0),U,4)=$P(^(0),U,4)+1 ;ENTRY COUNT
;
;IF NO 0 NODE FOR SUB-FILE 'VENDOR NAME' 9002075.01 CREATE IT
I '$D(^ACHSVPMT(DUZ(2),1,0)) D
.S ^ACHSVPMT(DUZ(2),1,0)=$$ZEROTH^ACHS(9002075,1)
.S $P(^ACHSVPMT(DUZ(2),1,0),U,3)=ACHSPROV ;LAST ENTRY USED
.S $P(^ACHSVPMT(DUZ(2),1,0),U,4)=0 ;ENTRY COUNT
;
;IF NOT VENDOR ENTRY CREATE ONE
I '$D(^ACHSVPMT(DUZ(2),1,ACHSPROV)) D
.S $P(^ACHSVPMT(DUZ(2),1,0),U,3)=ACHSPROV ;LAST ENTRY USED
.S $P(^ACHSVPMT(DUZ(2),1,0),U,4)=$P(^ACHSVPMT(DUZ(2),1,0),U,4)+1 ;LAST ENTRY
.S ^ACHSVPMT(DUZ(2),1,ACHSPROV,0)=ACHSPROV
.S ^ACHSVPMT(DUZ(2),1,"B",ACHSPROV,ACHSPROV)=""
;
;IF NO 0 NODE FOR SUB-FILE 'FISCAL YEAR' 9002075.02 CREATE IT
I '$D(^ACHSVPMT(DUZ(2),1,ACHSPROV,1,0)) D
.S ^ACHSVPMT(DUZ(2),1,ACHSPROV,1,0)=$$ZEROTH^ACHS(9002075,1,1)
;
;IF FISCAL YEAR ENTRY DOESN'T EXIST CREATE IT
I '$D(^ACHSVPMT(DUZ(2),1,ACHSPROV,1,ACHSCFY)) D
.S $P(^ACHSVPMT(DUZ(2),1,ACHSPROV,1,0),U,3)=ACHSCFY
.S $P(^ACHSVPMT(DUZ(2),1,ACHSPROV,1,0),U,4)=$P(^ACHSVPMT(DUZ(2),1,ACHSPROV,1,0),U,4)+1
;
;IF THE FISCAL YEAR 0 DATA NODE ISN'T THERE CREATE IT
I '$D(^ACHSVPMT(DUZ(2),1,ACHSPROV,1,ACHSCFY,0)) S ^ACHSVPMT(DUZ(2),1,ACHSPROV,1,ACHSCFY,0)=ACHSCFY_U_ACHSDAP_U_DT G END
;
;GET 'DOLLAR AMT PAID'
S X=$P(^ACHSVPMT(DUZ(2),1,ACHSPROV,1,ACHSCFY,0),U,2)
;
;INCREMENT IT BY ????? 'IHS PAYMENT AMOUNT' FROM TRANSACTION FILE
;OR VAR ACHSADAM WHICH IS ENTERED IN ^ACHSAJ BY THE USER AT THE
;"Payment Adjustment Amount" PROMPT
;HAVE TO LOOK CLOSE AT WHAT ACHSDAP IS AT THE TWO CALLS MADE
S $P(^ACHSVPMT(DUZ(2),1,ACHSPROV,1,ACHSCFY,0),U,2)=X+ACHSDAP
S $P(^ACHSVPMT(DUZ(2),1,ACHSPROV,1,ACHSCFY,0),U,3)=DT ;'LAST UPDATE DATE'
END ;
K ACHSDAP
Q
;
ACHSVPT ; IHS/ITSC/PMF - UPDATE VENDOR PAYMENTS FILE ; [ 10/16/2001 8:16 AM ]
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
+2 ;
+3 ;CALLED FROM
+4 ;ACHSAJ1+146
+5 ;ACHSPA0+72
+6 ;
+7 ;INPUT IS ACHSDAP ;AMOUNT TO BE ADDED TO
+8 ;
+9 ;CHS VENDOR PAYMENTS^9002075
+10 ;
+11 ;IF FACILITY ENTRY NOT THERE CREATE NEW ONE
+12 ;AGAIN A CASE WHERE FILEMAN SHOULD HANDLE THIS
+13 IF '$DATA(^ACHSVPMT(DUZ(2)))
Begin DoDot:1
+14 SET $PIECE(^ACHSVPMT(DUZ(2),0),U)=DUZ(2)
+15 SET ^ACHSVPMT("B",DUZ(2),DUZ(2))=""
+16 ;ENTRY COUNT
SET $PIECE(^ACHSVPMT(0),U,3)=DUZ(2)
SET $PIECE(^(0),U,4)=$PIECE(^(0),U,4)+1
End DoDot:1
+17 ;
+18 ;IF NO 0 NODE FOR SUB-FILE 'VENDOR NAME' 9002075.01 CREATE IT
+19 IF '$DATA(^ACHSVPMT(DUZ(2),1,0))
Begin DoDot:1
+20 SET ^ACHSVPMT(DUZ(2),1,0)=$$ZEROTH^ACHS(9002075,1)
+21 ;LAST ENTRY USED
SET $PIECE(^ACHSVPMT(DUZ(2),1,0),U,3)=ACHSPROV
+22 ;ENTRY COUNT
SET $PIECE(^ACHSVPMT(DUZ(2),1,0),U,4)=0
End DoDot:1
+23 ;
+24 ;IF NOT VENDOR ENTRY CREATE ONE
+25 IF '$DATA(^ACHSVPMT(DUZ(2),1,ACHSPROV))
Begin DoDot:1
+26 ;LAST ENTRY USED
SET $PIECE(^ACHSVPMT(DUZ(2),1,0),U,3)=ACHSPROV
+27 ;LAST ENTRY
SET $PIECE(^ACHSVPMT(DUZ(2),1,0),U,4)=$PIECE(^ACHSVPMT(DUZ(2),1,0),U,4)+1
+28 SET ^ACHSVPMT(DUZ(2),1,ACHSPROV,0)=ACHSPROV
+29 SET ^ACHSVPMT(DUZ(2),1,"B",ACHSPROV,ACHSPROV)=""
End DoDot:1
+30 ;
+31 ;IF NO 0 NODE FOR SUB-FILE 'FISCAL YEAR' 9002075.02 CREATE IT
+32 IF '$DATA(^ACHSVPMT(DUZ(2),1,ACHSPROV,1,0))
Begin DoDot:1
+33 SET ^ACHSVPMT(DUZ(2),1,ACHSPROV,1,0)=$$ZEROTH^ACHS(9002075,1,1)
End DoDot:1
+34 ;
+35 ;IF FISCAL YEAR ENTRY DOESN'T EXIST CREATE IT
+36 IF '$DATA(^ACHSVPMT(DUZ(2),1,ACHSPROV,1,ACHSCFY))
Begin DoDot:1
+37 SET $PIECE(^ACHSVPMT(DUZ(2),1,ACHSPROV,1,0),U,3)=ACHSCFY
+38 SET $PIECE(^ACHSVPMT(DUZ(2),1,ACHSPROV,1,0),U,4)=$PIECE(^ACHSVPMT(DUZ(2),1,ACHSPROV,1,0),U,4)+1
End DoDot:1
+39 ;
+40 ;IF THE FISCAL YEAR 0 DATA NODE ISN'T THERE CREATE IT
+41 IF '$DATA(^ACHSVPMT(DUZ(2),1,ACHSPROV,1,ACHSCFY,0))
SET ^ACHSVPMT(DUZ(2),1,ACHSPROV,1,ACHSCFY,0)=ACHSCFY_U_ACHSDAP_U_DT
GOTO END
+42 ;
+43 ;GET 'DOLLAR AMT PAID'
+44 SET X=$PIECE(^ACHSVPMT(DUZ(2),1,ACHSPROV,1,ACHSCFY,0),U,2)
+45 ;
+46 ;INCREMENT IT BY ????? 'IHS PAYMENT AMOUNT' FROM TRANSACTION FILE
+47 ;OR VAR ACHSADAM WHICH IS ENTERED IN ^ACHSAJ BY THE USER AT THE
+48 ;"Payment Adjustment Amount" PROMPT
+49 ;HAVE TO LOOK CLOSE AT WHAT ACHSDAP IS AT THE TWO CALLS MADE
+50 SET $PIECE(^ACHSVPMT(DUZ(2),1,ACHSPROV,1,ACHSCFY,0),U,2)=X+ACHSDAP
+51 ;'LAST UPDATE DATE'
SET $PIECE(^ACHSVPMT(DUZ(2),1,ACHSPROV,1,ACHSCFY,0),U,3)=DT
END ;
+1 KILL ACHSDAP
+2 QUIT
+3 ;
