PRCAPAT1 ;SF-ISC/YJK-SUBROUTINE - ASSIGN PAT REF# ,ALD CODE AND CALM CODE SHEET ;12/27/93 11:14 AM
V ;;4.5;Accounts Receivable;**64**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
;Assign pat ref # and generate CALM code sheet for new accounts rec.
;this is for accounting technician.
;Called by ^PRCAPAT
UP442 S DA=PRCHPO,DIE="^PRC(442,",DR=".1///"_DT_";5.1///"_PRCA("DEBTOR")_"" D ^DIE
Q
DT S %DT="",X="T" D ^%DT S DT=+Y K %DT
Q
SETAMIS ;set AMIS data for new accounts receivable.
S PRCAKCAT=$P(^PRCA(430,PRCABN,0),U,2) I PRCAKCAT'=$O(^PRCA(430.2,"AC",21,0)) Q:$P(^PRCA(430.2,PRCAKCAT,0),U,3)<240
D:'$D(DT) DT S:DT["." DT=$P(DT,".",1) S DIE="^PRCA(430,",DA=PRCABN,DR="16////"_DT_"" D ^DIE K DIE,DA,DR,PRCAKCAT S PRCAMIS=1 Q
DISPL W:$D(IOF) @IOF K DXS D ^PRCATO8 K DXS Q
EDGL ;S DIE="^PRCA(430,",DR="4",DA=PRCABN D ^DIE K DIE,DR,DA Q:$D(Y)
I '$D(PRCA("SITE")) S PRCA("SITE")=$S($G(PRCABN):$P($P($G(^PRCA(430,PRCABN,0)),"^"),"-"),1:$$SITE^RCMSITE)
D CP^PRCABIL1
S DIC="^PRCA(430,"_PRCABN_",2,",DIC(0)="AEQ" D ^DIC Q:+Y'>0 S DA=+Y
S DIE=DIC,DA(1)=PRCABN,DR="3" D ^DIE K DIE,DR,DA,DIC Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCAPAT1 1153 printed Oct 16, 2024@17:41:50 Page 2
PRCAPAT1 ;SF-ISC/YJK-SUBROUTINE - ASSIGN PAT REF# ,ALD CODE AND CALM CODE SHEET ;12/27/93 11:14 AM
V ;;4.5;Accounts Receivable;**64**;Mar 20, 1995
+1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ;Assign pat ref # and generate CALM code sheet for new accounts rec.
+3 ;this is for accounting technician.
+4 ;Called by ^PRCAPAT
UP442 SET DA=PRCHPO
SET DIE="^PRC(442,"
SET DR=".1///"_DT_";5.1///"_PRCA("DEBTOR")_""
DO ^DIE
+1 QUIT
DT SET %DT=""
SET X="T"
DO ^%DT
SET DT=+Y
KILL %DT
+1 QUIT
SETAMIS ;set AMIS data for new accounts receivable.
+1 SET PRCAKCAT=$PIECE(^PRCA(430,PRCABN,0),U,2)
IF PRCAKCAT'=$ORDER(^PRCA(430.2,"AC",21,0))
if $PIECE(^PRCA(430.2,PRCAKCAT,0),U,3)<240
QUIT
+2 if '$DATA(DT)
DO DT
if DT["."
SET DT=$PIECE(DT,".",1)
SET DIE="^PRCA(430,"
SET DA=PRCABN
SET DR="16////"_DT_""
DO ^DIE
KILL DIE,DA,DR,PRCAKCAT
SET PRCAMIS=1
QUIT
DISPL if $DATA(IOF)
WRITE @IOF
KILL DXS
DO ^PRCATO8
KILL DXS
QUIT
EDGL ;S DIE="^PRCA(430,",DR="4",DA=PRCABN D ^DIE K DIE,DR,DA Q:$D(Y)
+1 IF '$DATA(PRCA("SITE"))
SET PRCA("SITE")=$SELECT($GET(PRCABN):$PIECE($PIECE($GET(^PRCA(430,PRCABN,0)),"^"),"-"),1:$$SITE^RCMSITE)
+2 DO CP^PRCABIL1
+3 SET DIC="^PRCA(430,"_PRCABN_",2,"
SET DIC(0)="AEQ"
DO ^DIC
if +Y'>0
QUIT
SET DA=+Y
+4 SET DIE=DIC
SET DA(1)=PRCABN
SET DR="3"
DO ^DIE
KILL DIE,DR,DA,DIC
QUIT
