PRCNFAP ;SSI/ALA-Check for NX Capitalization (FAP) ;[ 02/19/97 11:33 AM ]
;;1.0;PRCN;**2,3,15**;Sep 13, 1996
FAC ; Check for FA completion
S TDA=0,STAT=23,CKA=1
F S TDA=$O(^PRCN(413.1,"AC",43,TDA)) Q:TDA="" D CK
G EXIT
CK S STDT=$P(^PRCN(413.1,TDA,0),U,8)
K OLDVALUE ; PRCN*1.0*15
S (N,SFL)=0 F S N=$O(^PRCN(413.1,TDA,1,N)) Q:'N D
. S PRCNTI=$P(^PRCN(413.1,TDA,1,N,0),U)
. D:PRCNFLAG OVAL ; PRCN*1.0*15 get original CMR and SGL values
. S PRCNFDA=$$CHKFA^ENFAUTL(PRCNTI)
. I $G(CKA)=1 D CKA Q
. I $G(CKD)=1 D CKD
I SFL S DR="6////^S X=STAT;7////^S X=DT",(DIC,DIE)=413.1,DA=TDA D ^DIE
Q
EXIT K STAT,STDT,N,PRCNTI,PRCNFDA,CKA,CKD,DIC,DIE,DA,DR
Q
FDC ; Check for FD completion
S TDA=0,STAT=24,CKD=1
F S TDA=$O(^PRCN(413.1,"AC",44,TDA)) Q:TDA="" D CK
G EXIT
CKA I ($P(PRCNFDA,U,2)>$P(PRCNFDA,U,3))&($P(PRCNFDA,U,2)'<STDT) S SFL=1
Q
CKD I $P(PRCNFDA,U,3)'<STDT S SFL=1
Q
;
OVAL ; PRCN*1.0*15 get original CMR, Use Status and SGL values
N OLDCMR,OLDSGL,OLDUST
S OLDCMR=$P($G(^ENG(6914,PRCNTI,2)),U,9)
S OLDUST=$P($G(^ENG(6914,PRCNTI,3)),U,1)
S OLDSGL=$P($G(^ENG(6914,PRCNTI,8)),U,6)
S OLDVALUE(N)=PRCNTI_U_OLDCMR_U_OLDUST_U_OLDSGL
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCNFAP 1198 printed Nov 22, 2024@17:04:31 Page 2
PRCNFAP ;SSI/ALA-Check for NX Capitalization (FAP) ;[ 02/19/97 11:33 AM ]
+1 ;;1.0;PRCN;**2,3,15**;Sep 13, 1996
FAC ; Check for FA completion
+1 SET TDA=0
SET STAT=23
SET CKA=1
+2 FOR
SET TDA=$ORDER(^PRCN(413.1,"AC",43,TDA))
if TDA=""
QUIT
DO CK
+3 GOTO EXIT
CK SET STDT=$PIECE(^PRCN(413.1,TDA,0),U,8)
+1 ; PRCN*1.0*15
KILL OLDVALUE
+2 SET (N,SFL)=0
FOR
SET N=$ORDER(^PRCN(413.1,TDA,1,N))
if 'N
QUIT
Begin DoDot:1
+3 SET PRCNTI=$PIECE(^PRCN(413.1,TDA,1,N,0),U)
+4 ; PRCN*1.0*15 get original CMR and SGL values
if PRCNFLAG
DO OVAL
+5 SET PRCNFDA=$$CHKFA^ENFAUTL(PRCNTI)
+6 IF $GET(CKA)=1
DO CKA
QUIT
+7 IF $GET(CKD)=1
DO CKD
End DoDot:1
+8 IF SFL
SET DR="6////^S X=STAT;7////^S X=DT"
SET (DIC,DIE)=413.1
SET DA=TDA
DO ^DIE
+9 QUIT
EXIT KILL STAT,STDT,N,PRCNTI,PRCNFDA,CKA,CKD,DIC,DIE,DA,DR
+1 QUIT
FDC ; Check for FD completion
+1 SET TDA=0
SET STAT=24
SET CKD=1
+2 FOR
SET TDA=$ORDER(^PRCN(413.1,"AC",44,TDA))
if TDA=""
QUIT
DO CK
+3 GOTO EXIT
CKA IF ($PIECE(PRCNFDA,U,2)>$PIECE(PRCNFDA,U,3))&($PIECE(PRCNFDA,U,2)'<STDT)
SET SFL=1
+1 QUIT
CKD IF $PIECE(PRCNFDA,U,3)'<STDT
SET SFL=1
+1 QUIT
+2 ;
OVAL ; PRCN*1.0*15 get original CMR, Use Status and SGL values
+1 NEW OLDCMR,OLDSGL,OLDUST
+2 SET OLDCMR=$PIECE($GET(^ENG(6914,PRCNTI,2)),U,9)
+3 SET OLDUST=$PIECE($GET(^ENG(6914,PRCNTI,3)),U,1)
+4 SET OLDSGL=$PIECE($GET(^ENG(6914,PRCNTI,8)),U,6)
+5 SET OLDVALUE(N)=PRCNTI_U_OLDCMR_U_OLDUST_U_OLDSGL
+6 QUIT
