PRCNFAP.m

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 ---PRCNFAP   1198     printed  Apr 09, 2024@20:59:42                                                                                                                                                                                                     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