PRCABIL ;SF-ISC/RSD-CREATE BILL IN FILE 430 ;6/1/94 2:43 PM
V ;;4.5;Accounts Receivable;**70**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
SVC K PRCAP("S") I $D(^VA(200,DUZ,5)),$D(^DIC(49,+^(5),0)) S PRCAP("S")=+^VA(200,DUZ,5) Q
W !,"You must be assigned a SERVICE/SECTION in the New Person file.",!?3,"See your Site Manager."
ENPOQ K DIC,DLAYGO,%DT,L,PRCAP,Z Q
EN3 ;CALLED FROM CROSS REFERENCE OF DEBTOR FIELD IN FILE 430
Q
EN4 ;SUMS AMOUNTS FOR DESCRIPTION FIELD IN FILE 430
S PRCAMT=0 F I=0:0 S I=$O(^PRCA(430,DA,101,I)) Q:'I I $D(^(I,0)) S X=^(0) S:$P(X,"^",6) PRCAMT=PRCAMT+$P(X,"^",6)
K I Q
EN5 ;CALLED FROM X-REF OF FIELD 7,MOVES DATA INTO FIELD 9
S PRCAKCAT=$S($D(^PRCA(430.2,+$P(^PRCA(430,DA,0),U,2),0)):$P(^(0),U,6),1:"") I "OV"[PRCAKCAT K PRCAKCAT Q
Q:'$D(^DPT(+X,0)) S PRCAK6=X,PRCAK7=DA,Z0=X_";DPT(" I $D(^RCD(340,"B",Z0)) S X=+$O(^(Z0,0)) G:$D(^RCD(340,X,0)) EN5S
K DD,DO S DIC="^RCD(340,",DIC(0)="L",DLAYGO=340,X=Z0 D FILE^DICN K DIC,DLAYGO,DO S X=+Y,DIC=DIE
EN5S S DA=PRCAK7 I "NT"[PRCAKCAT S ^PRCA(430,"C",X,DA)="",X=PRCAK6 K PRCAK7,PRCAK6,PRCAKCAT Q
K:$P(^PRCA(430,DA,0),U,9)]"" ^PRCA(430,"C",$P(^(0),U,9),DA) S $P(^PRCA(430,DA,0),U,9)=X,^PRCA(430,"C",X,DA)="" S X=PRCAK6 K PRCAKCAT,PRCAK6,PRCAK7,DLAYGO Q
EN6 ;SETS DIC("S") FOR DEBTOR FIELD IN FILE 430
K DIC("S") I $D(PRCABT) D
.I PRCABT=1!(PRCABT=2) S DIC("S")="I $P(^(0),U)[""PRC(440""!($P(^(0),U)[""DIC(4"")"
.I PRCABT=3 S DIC("S")="I $P(^(0),U)[""VA(200""!($P(^(0),U)[""PRC(440"")"
.Q
S:$D(PRCAT) DIC("S")="I $P(^(0),U)["_$S("CP"[PRCAT:""";DPT""","V"[PRCAT:""";PRC""","T"[PRCAT:""";DIC(36""","N"[PRCAT:""";DIC(4""","O"[PRCAT:""";VA(200""",1:""";VA(200""!($P(^(0),U)["";PRC"")")
I $D(PRCABT) D
.I PRCABT=1!(PRCABT=2) S DIC("V")="I "",440,4,""[("",""_+$P(^(0),U)_"","")"
.I PRCABT=3 S DIC("V")="I "",440,200,""[("",""_+$P(^(0),U)_"","")"
.Q
S:$D(PRCAT) DIC("V")="I $P(^(0),U,1,2)["_$S("CP"[PRCAT:"""2^""","V"[PRCAT:"""440""","T"[PRCAT:"""36""","N"[PRCAT:"""4^I""","O"[PRCAT:"""200""",1:"""200""!($P(^(0),U)[""440"")") Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCABIL 2079 printed Apr 09, 2024@20:44:23 Page 2
PRCABIL ;SF-ISC/RSD-CREATE BILL IN FILE 430 ;6/1/94 2:43 PM
V ;;4.5;Accounts Receivable;**70**;Mar 20, 1995
+1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
SVC KILL PRCAP("S")
IF $DATA(^VA(200,DUZ,5))
IF $DATA(^DIC(49,+^(5),0))
SET PRCAP("S")=+^VA(200,DUZ,5)
QUIT
+1 WRITE !,"You must be assigned a SERVICE/SECTION in the New Person file.",!?3,"See your Site Manager."
ENPOQ KILL DIC,DLAYGO,%DT,L,PRCAP,Z
QUIT
EN3 ;CALLED FROM CROSS REFERENCE OF DEBTOR FIELD IN FILE 430
+1 QUIT
EN4 ;SUMS AMOUNTS FOR DESCRIPTION FIELD IN FILE 430
+1 SET PRCAMT=0
FOR I=0:0
SET I=$ORDER(^PRCA(430,DA,101,I))
if 'I
QUIT
IF $DATA(^(I,0))
SET X=^(0)
if $PIECE(X,"^",6)
SET PRCAMT=PRCAMT+$PIECE(X,"^",6)
+2 KILL I
QUIT
EN5 ;CALLED FROM X-REF OF FIELD 7,MOVES DATA INTO FIELD 9
+1 SET PRCAKCAT=$SELECT($DATA(^PRCA(430.2,+$PIECE(^PRCA(430,DA,0),U,2),0)):$PIECE(^(0),U,6),1:"")
IF "OV"[PRCAKCAT
KILL PRCAKCAT
QUIT
+2 if '$DATA(^DPT(+X,0))
QUIT
SET PRCAK6=X
SET PRCAK7=DA
SET Z0=X_";DPT("
IF $DATA(^RCD(340,"B",Z0))
SET X=+$ORDER(^(Z0,0))
if $DATA(^RCD(340,X,0))
GOTO EN5S
+3 KILL DD,DO
SET DIC="^RCD(340,"
SET DIC(0)="L"
SET DLAYGO=340
SET X=Z0
DO FILE^DICN
KILL DIC,DLAYGO,DO
SET X=+Y
SET DIC=DIE
EN5S SET DA=PRCAK7
IF "NT"[PRCAKCAT
SET ^PRCA(430,"C",X,DA)=""
SET X=PRCAK6
KILL PRCAK7,PRCAK6,PRCAKCAT
QUIT
+1 if $PIECE(^PRCA(430,DA,0),U,9)]""
KILL ^PRCA(430,"C",$PIECE(^(0),U,9),DA)
SET $PIECE(^PRCA(430,DA,0),U,9)=X
SET ^PRCA(430,"C",X,DA)=""
SET X=PRCAK6
KILL PRCAKCAT,PRCAK6,PRCAK7,DLAYGO
QUIT
EN6 ;SETS DIC("S") FOR DEBTOR FIELD IN FILE 430
+1 KILL DIC("S")
IF $DATA(PRCABT)
Begin DoDot:1
+2 IF PRCABT=1!(PRCABT=2)
SET DIC("S")="I $P(^(0),U)[""PRC(440""!($P(^(0),U)[""DIC(4"")"
+3 IF PRCABT=3
SET DIC("S")="I $P(^(0),U)[""VA(200""!($P(^(0),U)[""PRC(440"")"
+4 QUIT
End DoDot:1
+5 if $DATA(PRCAT)
SET DIC("S")="I $P(^(0),U)["_$SELECT("CP"[PRCAT:""";DPT""","V"[PRCAT:""";PRC""","T"[PRCAT:""";DIC(36""","N"[PRCAT:""";DIC(4""","O"[PRCAT:""";VA(200""",1:""";VA(200""!($P(^(0),U)["";PRC"")")
+6 IF $DATA(PRCABT)
Begin DoDot:1
+7 IF PRCABT=1!(PRCABT=2)
SET DIC("V")="I "",440,4,""[("",""_+$P(^(0),U)_"","")"
+8 IF PRCABT=3
SET DIC("V")="I "",440,200,""[("",""_+$P(^(0),U)_"","")"
+9 QUIT
End DoDot:1
+10 if $DATA(PRCAT)
SET DIC("V")="I $P(^(0),U,1,2)["_$SELECT("CP"[PRCAT:"""2^""","V"[PRCAT:"""440""","T"[PRCAT:"""36""","N"[PRCAT:"""4^I""","O"[PRCAT:"""200""",1:"""200""!($P(^(0),U)[""440"")")
QUIT
