- 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 ;
