- 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 Jan 18, 2025@02:40:12 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