PRCHES4.m

PRCHES4 ;WISC/RHD/AKS-ESIG MAINTENANCE ROUTINE ;3/18/93  15:29

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

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

 ;ROUTINE FOR MAINTAINING SUBFIELD 4 (ELECTRONIC SIGNATURE)

 ; FIELD 2.4 (OBLIGATION DATA), FILE 442

DECODE(LEVEL0,LEVEL1) ;return esig in readable form.

 ;returns "" if unsuccessful

 NEW RECORD,VERSION,PERSON,SIG,CHECKSUM

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

 S VERSION=$P(RECORD,"^",7)

 S PERSON=+$P(RECORD,"^",2)

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

 S SIG=$P(RECORD,"^",5)

D1 ;decode esig for version 1

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

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

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

 NEW RECORD,SIGBLOCK,CHECKSUM,OLDUSER

 S USERNUM=+USERNUM

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

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

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

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

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

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

 S OLDUSER=+$P(RECORD,"^",2)

 I OLDUSER=0 S $P(RECORD,"^",2)=USERNUM

 I OLDUSER>0 S USERNUM=OLDUSER

 S:$P(RECORD,"^",6)="" $P(RECORD,"^",6)=$$NOW^PRCUESIG

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

 S $P(RECORD,"^",5)=$$ENCODE^PRCUESIG(SIGBLOCK,USERNUM,CHECKSUM)

 S $P(RECORD,"^",7,8)="1^"_$$SUM^PRCUESIG(SIGBLOCK)

 S ^PRC(442,LEVEL0,10,LEVEL1,0)=RECORD

 S Y=1 Q

REMOVE(LEVEL0,LEVEL1) ;NOT an extrinsic function

 NEW I,RECORD

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

 F I=2,5,6,8 S $P(RECORD,"^",I)=""

 S ^PRC(442,LEVEL0,10,LEVEL1,0)=RECORD

 Q

VERIFY(LEVEL0,LEVEL1)      ;extrinsic function to verify version 1 signature.  Returns 1 if valid, 0 if not valid

 NEW RECORD,VERSION,SIGBLOCK

 ;get record variables

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

 S VERSION=$P(RECORD,"^",7),SIGBLOCK=$P(RECORD,"^",8)

 I VERSION_SIGBLOCK="" Q 1

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

STRING(X)          ;Build String of critical fields

 Q $P(X,"^")_"^"_$P(X,"^",3)_"^"_$P(X,"^",4)_"^"_$P(X,"^",6)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCHES4   2195     printed  Feb 18, 2025@23:33:45                                                                                                                                                                                                     Page 2

PRCHES4   ;WISC/RHD/AKS-ESIG MAINTENANCE ROUTINE ;3/18/93  15:29

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 4 (ELECTRONIC SIGNATURE)

 +3       ; FIELD 2.4 (OBLIGATION DATA), FILE 442

DECODE(LEVEL0,LEVEL1) ;return esig in readable form.

 +1       ;returns "" if unsuccessful

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

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

           IF RECORD=""

               QUIT ""

 +4        SET VERSION=$PIECE(RECORD,"^",7)

 +5        SET PERSON=+$PIECE(RECORD,"^",2)

 +6        IF VERSION'=""

               IF VERSION'=1

                   QUIT ""

 +7        SET SIG=$PIECE(RECORD,"^",5)

D1        ;decode esig for version 1

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

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

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

 +1        NEW RECORD,SIGBLOCK,CHECKSUM,OLDUSER

 +2        SET USERNUM=+USERNUM

 +3       ;-3 no user number

           IF USERNUM=0

               SET Y=-3

               QUIT 

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

 +5       ;-2 no signature block in file 200

           IF SIGBLOCK=""

               SET Y=-2

               QUIT 

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

 +7       ;-1 no 2237 record

           IF RECORD=""

               SET Y=-1

               QUIT 

 +8       ;-4 cannot re-sign record

           IF $PIECE(RECORD,"^",5)'=""

               SET Y=-4

               QUIT 

 +9        SET OLDUSER=+$PIECE(RECORD,"^",2)

 +10       IF OLDUSER=0

               SET $PIECE(RECORD,"^",2)=USERNUM

 +11       IF OLDUSER>0

               SET USERNUM=OLDUSER

 +12       if $PIECE(RECORD,"^",6)=""

               SET $PIECE(RECORD,"^",6)=$$NOW^PRCUESIG

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

 +14       SET $PIECE(RECORD,"^",5)=$$ENCODE^PRCUESIG(SIGBLOCK,USERNUM,CHECKSUM)

 +15       SET $PIECE(RECORD,"^",7,8)="1^"_$$SUM^PRCUESIG(SIGBLOCK)

 +16       SET ^PRC(442,LEVEL0,10,LEVEL1,0)=RECORD

 +17       SET Y=1

           QUIT 

REMOVE(LEVEL0,LEVEL1) ;NOT an extrinsic function

 +1        NEW I,RECORD

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

           if RECORD=""

               QUIT 

 +3        FOR I=2,5,6,8

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

 +4        SET ^PRC(442,LEVEL0,10,LEVEL1,0)=RECORD

 +5        QUIT 

VERIFY(LEVEL0,LEVEL1) ;extrinsic function to verify version 1 signature.  Returns 1 if valid, 0 if not valid

 +1        NEW RECORD,VERSION,SIGBLOCK

 +2       ;get record variables

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

 +4        SET VERSION=$PIECE(RECORD,"^",7)

           SET SIGBLOCK=$PIECE(RECORD,"^",8)

 +5        IF VERSION_SIGBLOCK=""

               QUIT 1

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

STRING(X) ;Build String of critical fields

 +1        QUIT $PIECE(X,"^")_"^"_$PIECE(X,"^",3)_"^"_$PIECE(X,"^",4)_"^"_$PIECE(X,"^",6)