ESPOID.m

ESPOID ;DALISC/CKA; FIND A UNIQUE ID #;7/92

 ;;1.0;POLICE & SECURITY;**22**;Mar 31, 1994

VIO D NOW^%DTC S YR=$E(%I(3),2,3),S=+$$SITE^VASITE,X=$P(^ESP(914,0),U,3) S:$E(X,$L(S)+1,$L(S)+2)'=YR $P(^ESP(914,0),U,3)=S_YR_"000000"

 S X=$P(^ESP(914,0),U,3)+1 F I=1:1 Q:'$D(^ESP(914,X))  S X=X+1

 Q

OFF D NOW^%DTC S YR=$E(%I(3),2,3),S=+$$SITE^VASITE,X=$P(^ESP(912,0),U,3) S:$E(X,$L(S)+1,$L(S)+2)'=YR!(X="") $P(^ESP(912,0),U,3)=S_YR_"000000"

 S X=$P(^ESP(912,0),U,3)+1 F I=1:1 Q:'$D(^ESP(912,X))  S X=X+1

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ESPOID   506     printed  Apr 09, 2024@21:32:44                                                                                                                                                                                                       Page 2

ESPOID    ;DALISC/CKA; FIND A UNIQUE ID #;7/92

 +1       ;;1.0;POLICE & SECURITY;**22**;Mar 31, 1994

VIO        DO NOW^%DTC

           SET YR=$EXTRACT(%I(3),2,3)

           SET S=+$$SITE^VASITE

           SET X=$PIECE(^ESP(914,0),U,3)

           if $EXTRACT(X,$LENGTH(S)+1,$LENGTH(S)+2)'=YR

               SET $PIECE(^ESP(914,0),U,3)=S_YR_"000000"

 +1        SET X=$PIECE(^ESP(914,0),U,3)+1

           FOR I=1:1

               if '$DATA(^ESP(914,X))

                   QUIT 

               SET X=X+1

 +2        QUIT 

OFF        DO NOW^%DTC

           SET YR=$EXTRACT(%I(3),2,3)

           SET S=+$$SITE^VASITE

           SET X=$PIECE(^ESP(912,0),U,3)

           if $EXTRACT(X,$LENGTH(S)+1,$LENGTH(S)+2)'=YR!(X="")

               SET $PIECE(^ESP(912,0),U,3)=S_YR_"000000"

 +1        SET X=$PIECE(^ESP(912,0),U,3)+1

           FOR I=1:1

               if '$DATA(^ESP(912,X))

                   QUIT 

               SET X=X+1

 +2        QUIT