| 1 | PRCNFAP ;SSI/ALA-Check for NX Capitalization (FAP) ;[ 02/19/97 11:33 AM ]
|
|---|
| 2 | ;;1.0;PRCN;**2,3,15**;Sep 13, 1996
|
|---|
| 3 | FAC ; Check for FA completion
|
|---|
| 4 | S TDA=0,STAT=23,CKA=1
|
|---|
| 5 | F S TDA=$O(^PRCN(413.1,"AC",43,TDA)) Q:TDA="" D CK
|
|---|
| 6 | G EXIT
|
|---|
| 7 | CK S STDT=$P(^PRCN(413.1,TDA,0),U,8)
|
|---|
| 8 | K OLDVALUE ; PRCN*1.0*15
|
|---|
| 9 | S (N,SFL)=0 F S N=$O(^PRCN(413.1,TDA,1,N)) Q:'N D
|
|---|
| 10 | . S PRCNTI=$P(^PRCN(413.1,TDA,1,N,0),U)
|
|---|
| 11 | . D:PRCNFLAG OVAL ; PRCN*1.0*15 get original CMR and SGL values
|
|---|
| 12 | . S PRCNFDA=$$CHKFA^ENFAUTL(PRCNTI)
|
|---|
| 13 | . I $G(CKA)=1 D CKA Q
|
|---|
| 14 | . I $G(CKD)=1 D CKD
|
|---|
| 15 | I SFL S DR="6////^S X=STAT;7////^S X=DT",(DIC,DIE)=413.1,DA=TDA D ^DIE
|
|---|
| 16 | Q
|
|---|
| 17 | EXIT K STAT,STDT,N,PRCNTI,PRCNFDA,CKA,CKD,DIC,DIE,DA,DR
|
|---|
| 18 | Q
|
|---|
| 19 | FDC ; Check for FD completion
|
|---|
| 20 | S TDA=0,STAT=24,CKD=1
|
|---|
| 21 | F S TDA=$O(^PRCN(413.1,"AC",44,TDA)) Q:TDA="" D CK
|
|---|
| 22 | G EXIT
|
|---|
| 23 | CKA I ($P(PRCNFDA,U,2)>$P(PRCNFDA,U,3))&($P(PRCNFDA,U,2)'<STDT) S SFL=1
|
|---|
| 24 | Q
|
|---|
| 25 | CKD I $P(PRCNFDA,U,3)'<STDT S SFL=1
|
|---|
| 26 | Q
|
|---|
| 27 | ;
|
|---|
| 28 | OVAL ; PRCN*1.0*15 get original CMR, Use Status and SGL values
|
|---|
| 29 | N OLDCMR,OLDSGL,OLDUST
|
|---|
| 30 | S OLDCMR=$P($G(^ENG(6914,PRCNTI,2)),U,9)
|
|---|
| 31 | S OLDUST=$P($G(^ENG(6914,PRCNTI,3)),U,1)
|
|---|
| 32 | S OLDSGL=$P($G(^ENG(6914,PRCNTI,8)),U,6)
|
|---|
| 33 | S OLDVALUE(N)=PRCNTI_U_OLDCMR_U_OLDUST_U_OLDSGL
|
|---|
| 34 | Q
|
|---|
