PRCHES3.m

PRCHES3 ;WISC/RHD/AKS-ESIG MAINTENANCE ROUTINE ;3/18/93  12:49

V ;;5.1;IFCAP;;Oct 20, 2000

 ;Per VHA Directive 10-93-142, this routine should not be modified.

 ;ROUTINE FOR MAINTAINING SUBFIELD 19.4 (LCS ELEC. SIG)

 ; FIELD .6 (PARTIAL), FILE 442

DECODE(LEVEL0,LEVEL1) ;return esig to readable form

 ;returns "" if unsuccessful

 NEW RECORD,RECORD1,VERSION,PERSON,SIG,CHECKSUM

 S RECORD=$G(^PRC(442,LEVEL0,11,LEVEL1,0)) I RECORD="" Q ""

 S RECORD1=$G(^PRC(442,LEVEL0,11,LEVEL1,1))

 S VERSION=$P(RECORD1,"^",13)

 S PERSON=+$P(RECORD1,"^",3)

 I VERSION'="",VERSION'=1 Q ""

 S SIG=$P(RECORD1,"^",4)

D1 ;decode e signature for version 1

 S CHECKSUM=$$SUM^PRCUESIG(LEVEL0_"^"_LEVEL1_"^"_$$STRING(RECORD,RECORD1))

 Q $$DECODE^PRCUESIG(SIG,PERSON,CHECKSUM)

ENCODE(LEVEL0,LEVEL1,USERNUM,Y) ;Encode e signature for version 1 only

 NEW RECORD,RECORD1,SIGBLOCK,CHECKSUM,OLDUSER

 S USERNUM=+USERNUM

 I USERNUM=0 S Y=-3 Q  ;-3 no user number available for filing

 S SIGBLOCK=$P($G(^VA(200,USERNUM,20)),"^",2)

 I SIGBLOCK="" S Y=-2 Q  ;-2 no signature block

 S RECORD=$G(^PRC(442,LEVEL0,11,LEVEL1,0))

 S RECORD1=$G(^PRC(442,LEVEL0,11,LEVEL1,1))

 I RECORD="" S Y=-1 Q  ;-1 no 2237 record

 I $P(RECORD1,"^",4)'="" S Y=-4 Q  ;-4 cannot re-sign record

 S OLDUSER=+$P(RECORD1,"^",3)

 I OLDUSER=0 S $P(RECORD1,"^",3)=USERNUM

 I OLDUSER>0 S USERNUM=OLDUSER

 S:$P(RECORD1,"^",5)="" $P(RECORD1,"^",5)=$$NOW^PRCUESIG

 S CHECKSUM=$$SUM^PRCUESIG(LEVEL0_"^"_LEVEL1_"^"_$$STRING(RECORD,RECORD1))

 S $P(RECORD1,"^",4)=$$ENCODE^PRCUESIG(SIGBLOCK,USERNUM,CHECKSUM)

 S $P(RECORD1,"^",13,14)="1^"_$$SUM^PRCUESIG(SIGBLOCK)

 S ^PRC(442,LEVEL0,11,LEVEL1,1)=RECORD1

 S Y=1 Q

REMOVE(LEVEL0,LEVEL1) ;Entry point to remove esig

 NEW I,RECORD1

 S RECORD1=$G(^PRC(442,LEVEL0,11,LEVEL1,1)) Q:RECORD1=""

 F I=3,4,5,14 S $P(RECORD1,"^",I)=""

 S ^PRC(442,LEVEL0,11,LEVEL1,1)=RECORD1

 Q

VERIFY(LEVEL0,LEVEL1)      ;extrinsic function to verify version 1 esig  Returns 1 if valid

 NEW RECORD,RECORD1,VERSION,SIGBLOCK

 S RECORD=$G(^PRC(442,LEVEL0,11,LEVEL1,0))

 S RECORD1=$G(^PRC(442,LEVEL0,11,LEVEL1,1))

 S VERSION=$P(RECORD1,"^",13),SIGBLOCK=$P(RECORD1,"^",14)

 I VERSION_SIGBLOCK="" Q 1

 Q ($$SUM^PRCUESIG($$DECODE(LEVEL0,LEVEL1))=SIGBLOCK)

STRING(X,X1)          ;Build String of critical fields

 Q $P(X,"^")_"^"_$P(X1,"^",5)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCHES3   2330     printed  Apr 23, 2025@18:21:50                                                                                                                                                                                                     Page 2

PRCHES3   ;WISC/RHD/AKS-ESIG MAINTENANCE ROUTINE ;3/18/93  12:49

V         ;;5.1;IFCAP;;Oct 20, 2000

 +1       ;Per VHA Directive 10-93-142, this routine should not be modified.

 +2       ;ROUTINE FOR MAINTAINING SUBFIELD 19.4 (LCS ELEC. SIG)

 +3       ; FIELD .6 (PARTIAL), FILE 442

DECODE(LEVEL0,LEVEL1) ;return esig to readable form

 +1       ;returns "" if unsuccessful

 +2        NEW RECORD,RECORD1,VERSION,PERSON,SIG,CHECKSUM

 +3        SET RECORD=$GET(^PRC(442,LEVEL0,11,LEVEL1,0))

           IF RECORD=""

               QUIT ""

 +4        SET RECORD1=$GET(^PRC(442,LEVEL0,11,LEVEL1,1))

 +5        SET VERSION=$PIECE(RECORD1,"^",13)

 +6        SET PERSON=+$PIECE(RECORD1,"^",3)

 +7        IF VERSION'=""

               IF VERSION'=1

                   QUIT ""

 +8        SET SIG=$PIECE(RECORD1,"^",4)

D1        ;decode e signature for version 1

 +1        SET CHECKSUM=$$SUM^PRCUESIG(LEVEL0_"^"_LEVEL1_"^"_$$STRING(RECORD,RECORD1))

 +2        QUIT $$DECODE^PRCUESIG(SIG,PERSON,CHECKSUM)

ENCODE(LEVEL0,LEVEL1,USERNUM,Y) ;Encode e signature for version 1 only

 +1        NEW RECORD,RECORD1,SIGBLOCK,CHECKSUM,OLDUSER

 +2        SET USERNUM=+USERNUM

 +3       ;-3 no user number available for filing

           IF USERNUM=0

               SET Y=-3

               QUIT 

 +4        SET SIGBLOCK=$PIECE($GET(^VA(200,USERNUM,20)),"^",2)

 +5       ;-2 no signature block

           IF SIGBLOCK=""

               SET Y=-2

               QUIT 

 +6        SET RECORD=$GET(^PRC(442,LEVEL0,11,LEVEL1,0))

 +7        SET RECORD1=$GET(^PRC(442,LEVEL0,11,LEVEL1,1))

 +8       ;-1 no 2237 record

           IF RECORD=""

               SET Y=-1

               QUIT 

 +9       ;-4 cannot re-sign record

           IF $PIECE(RECORD1,"^",4)'=""

               SET Y=-4

               QUIT 

 +10       SET OLDUSER=+$PIECE(RECORD1,"^",3)

 +11       IF OLDUSER=0

               SET $PIECE(RECORD1,"^",3)=USERNUM

 +12       IF OLDUSER>0

               SET USERNUM=OLDUSER

 +13       if $PIECE(RECORD1,"^",5)=""

               SET $PIECE(RECORD1,"^",5)=$$NOW^PRCUESIG

 +14       SET CHECKSUM=$$SUM^PRCUESIG(LEVEL0_"^"_LEVEL1_"^"_$$STRING(RECORD,RECORD1))

 +15       SET $PIECE(RECORD1,"^",4)=$$ENCODE^PRCUESIG(SIGBLOCK,USERNUM,CHECKSUM)

 +16       SET $PIECE(RECORD1,"^",13,14)="1^"_$$SUM^PRCUESIG(SIGBLOCK)

 +17       SET ^PRC(442,LEVEL0,11,LEVEL1,1)=RECORD1

 +18       SET Y=1

           QUIT 

REMOVE(LEVEL0,LEVEL1) ;Entry point to remove esig

 +1        NEW I,RECORD1

 +2        SET RECORD1=$GET(^PRC(442,LEVEL0,11,LEVEL1,1))

           if RECORD1=""

               QUIT 

 +3        FOR I=3,4,5,14

               SET $PIECE(RECORD1,"^",I)=""

 +4        SET ^PRC(442,LEVEL0,11,LEVEL1,1)=RECORD1

 +5        QUIT 

VERIFY(LEVEL0,LEVEL1) ;extrinsic function to verify version 1 esig  Returns 1 if valid

 +1        NEW RECORD,RECORD1,VERSION,SIGBLOCK

 +2        SET RECORD=$GET(^PRC(442,LEVEL0,11,LEVEL1,0))

 +3        SET RECORD1=$GET(^PRC(442,LEVEL0,11,LEVEL1,1))

 +4        SET VERSION=$PIECE(RECORD1,"^",13)

           SET SIGBLOCK=$PIECE(RECORD1,"^",14)

 +5        IF VERSION_SIGBLOCK=""

               QUIT 1

 +6        QUIT ($$SUM^PRCUESIG($$DECODE(LEVEL0,LEVEL1))=SIGBLOCK)

STRING(X,X1) ;Build String of critical fields

 +1        QUIT $PIECE(X,"^")_"^"_$PIECE(X1,"^",5)