PRCHES8.m

PRCHES8 ;WISC/RHD/AKS-ESIG MAINT ;3/18/93  15:38

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

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

 ;ROUTINE FOR MAINTAINING FIELD 105 (LOG CODE SHEET ELEC. SIG), FILE 442

DECODE(LEVEL0) ;return esig to readable form

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

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

 S RECORD18=$G(^PRC(442,LEVEL0,18))

 S VERSION=$P(RECORD18,"^",15)

 S PERSON=+$P(RECORD18,"^",5)

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

 S SIG=$P(RECORD18,"^",6)

D1 ;decode e signature for version 1

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

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

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

 NEW RECORD,RECORD18,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

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

 S RECORD18=$G(^PRC(442,LEVEL0,18))

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

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

 S OLDUSER=+$P(RECORD18,"^",5)

 I OLDUSER=0 S $P(RECORD18,"^",5)=USERNUM

 I OLDUSER>0 S USERNUM=OLDUSER

 S:$P(RECORD18,"^",7)="" $P(RECORD18,"^",7)=$$NOW^PRCUESIG

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

 S $P(RECORD18,"^",6)=$$ENCODE^PRCUESIG(SIGBLOCK,USERNUM,CHECKSUM)

 S $P(RECORD18,"^",15,16)="1^"_$$SUM^PRCUESIG(SIGBLOCK)

 S ^PRC(442,LEVEL0,18)=RECORD18

 S Y=1 Q

REMOVE(LEVEL0) ;Entry point to remove esig

 NEW I,RECORD18

 S RECORD18=$G(^PRC(442,LEVEL0,18)) Q:RECORD18=""

 F I=5,6,7,16 S $P(RECORD18,"^",I)=""

 S ^PRC(442,LEVEL0,18)=RECORD18

 Q

VERIFY(LEVEL0)      ;verify ver 1 sig  Returns 1 if valid

 NEW RECORD18,VERSION,SIGBLOCK

 S RECORD18=$G(^PRC(442,LEVEL0,18))

 S VERSION=$P(RECORD18,"^",15),SIGBLOCK=$P(RECORD18,"^",16)

 I VERSION_SIGBLOCK="" Q 1

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

STRING(X18)          ;Build String of critical fields

 Q $P(X18,"^",7)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCHES8   2030     printed  Apr 23, 2025@18:21:55                                                                                                                                                                                                     Page 2

PRCHES8   ;WISC/RHD/AKS-ESIG MAINT ;3/18/93  15:38

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

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

 +2       ;ROUTINE FOR MAINTAINING FIELD 105 (LOG CODE SHEET ELEC. SIG), FILE 442

DECODE(LEVEL0) ;return esig to readable form

 +1        NEW RECORD,RECORD1,RECORD18,VERSION,PERSON,SIG,CHECKSUM

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

           IF RECORD=""

               QUIT ""

 +3        SET RECORD18=$GET(^PRC(442,LEVEL0,18))

 +4        SET VERSION=$PIECE(RECORD18,"^",15)

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

 +6        IF VERSION'=""

               IF VERSION'=1

                   QUIT ""

 +7        SET SIG=$PIECE(RECORD18,"^",6)

D1        ;decode e signature for version 1

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

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

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

 +1        NEW RECORD,RECORD18,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

           IF SIGBLOCK=""

               SET Y=-2

               QUIT 

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

 +7        SET RECORD18=$GET(^PRC(442,LEVEL0,18))

 +8       ;-1 no record

           IF RECORD=""

               SET Y=-1

               QUIT 

 +9       ;-4 cannot re-sign record

           IF $PIECE(RECORD18,"^",6)'=""

               SET Y=-4

               QUIT 

 +10       SET OLDUSER=+$PIECE(RECORD18,"^",5)

 +11       IF OLDUSER=0

               SET $PIECE(RECORD18,"^",5)=USERNUM

 +12       IF OLDUSER>0

               SET USERNUM=OLDUSER

 +13       if $PIECE(RECORD18,"^",7)=""

               SET $PIECE(RECORD18,"^",7)=$$NOW^PRCUESIG

 +14       SET CHECKSUM=$$SUM^PRCUESIG(LEVEL0_"^"_$$STRING(RECORD18))

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

 +16       SET $PIECE(RECORD18,"^",15,16)="1^"_$$SUM^PRCUESIG(SIGBLOCK)

 +17       SET ^PRC(442,LEVEL0,18)=RECORD18

 +18       SET Y=1

           QUIT 

REMOVE(LEVEL0) ;Entry point to remove esig

 +1        NEW I,RECORD18

 +2        SET RECORD18=$GET(^PRC(442,LEVEL0,18))

           if RECORD18=""

               QUIT 

 +3        FOR I=5,6,7,16

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

 +4        SET ^PRC(442,LEVEL0,18)=RECORD18

 +5        QUIT 

VERIFY(LEVEL0) ;verify ver 1 sig  Returns 1 if valid

 +1        NEW RECORD18,VERSION,SIGBLOCK

 +2        SET RECORD18=$GET(^PRC(442,LEVEL0,18))

 +3        SET VERSION=$PIECE(RECORD18,"^",15)

           SET SIGBLOCK=$PIECE(RECORD18,"^",16)

 +4        IF VERSION_SIGBLOCK=""

               QUIT 1

 +5        QUIT ($$SUM^PRCUESIG($$DECODE(LEVEL0))=SIGBLOCK)

STRING(X18) ;Build String of critical fields

 +1        QUIT $PIECE(X18,"^",7)