SPNPOS19.m

SPNPOS19 ;SD/WDE/Post action for patch 19; 1/16/2003

 ;;2.0;Spinal Cord Dysfunction;**19**;01/02/1997

 ;

EN ;

 S U="^"

 Q:$G(^DD(154.1,1003,0))'=""  ; early quit if patch 19 prev installed

 S SPNFD0=0 F  S SPNFD0=$O(^SPNL(154.1,SPNFD0)) Q:(SPNFD0="")!('+SPNFD0)  D

 .W "."

 .D SCORE  ;conver score type 5's to 11's

 .Q

RSTAT ;

 S SPNDFN=0 F  S SPNDFN=$O(^SPNL(154,SPNDFN)) Q:'+SPNDFN  D DOD,XMTDEL

 K ^DD(154,.04,5,1,0)

 K ^DD(154,.03,1,2)  ;delete left-over trigger

ZAP ;

 K SPNDFN,SPNFD0,SPNX,SPNY,SPNZ

 Q

SCORE ;Conver score type to new values

 S SPNX=""

 S SPNX=$P($G(^SPNL(154.1,SPNFD0,2)),U,17)  ;score type

 I SPNX="" Q

 I SPNX=5 S $P(^SPNL(154.1,SPNFD0,2),U,17)=11

 K SPNX

 Q

DOD ;

 ;date of death update

 D LOOP^SPNDODCK(SPNDFN) ; Update Reg Status based on DOD file 2

 D LOOP2^SPNDODCK(SPNDFN) ; Updating Reg Status

 Q

XMTDEL ;

 I $D(^SPNL(154,SPNDFN,"XMT")) K ^SPNL(154,SPNDFN,"XMT")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SPNPOS19   930     printed  Apr 09, 2024@21:40:25                                                                                                                                                                                                     Page 2

SPNPOS19  ;SD/WDE/Post action for patch 19; 1/16/2003

 +1       ;;2.0;Spinal Cord Dysfunction;**19**;01/02/1997

 +2       ;

EN        ;

 +1        SET U="^"

 +2       ; early quit if patch 19 prev installed

           if $GET(^DD(154.1,1003,0))'=""

               QUIT 

 +3        SET SPNFD0=0

           FOR 

               SET SPNFD0=$ORDER(^SPNL(154.1,SPNFD0))

               if (SPNFD0="")!('+SPNFD0)

                   QUIT 

               Begin DoDot:1

 +4                WRITE "."

 +5       ;conver score type 5's to 11's

                   DO SCORE

 +6                QUIT 

               End DoDot:1

RSTAT     ;

 +1        SET SPNDFN=0

           FOR 

               SET SPNDFN=$ORDER(^SPNL(154,SPNDFN))

               if '+SPNDFN

                   QUIT 

               DO DOD

               DO XMTDEL

 +2        KILL ^DD(154,.04,5,1,0)

 +3       ;delete left-over trigger

           KILL ^DD(154,.03,1,2)

ZAP       ;

 +1        KILL SPNDFN,SPNFD0,SPNX,SPNY,SPNZ

 +2        QUIT 

SCORE     ;Conver score type to new values

 +1        SET SPNX=""

 +2       ;score type

           SET SPNX=$PIECE($GET(^SPNL(154.1,SPNFD0,2)),U,17)

 +3        IF SPNX=""

               QUIT 

 +4        IF SPNX=5

               SET $PIECE(^SPNL(154.1,SPNFD0,2),U,17)=11

 +5        KILL SPNX

 +6        QUIT 

DOD       ;

 +1       ;date of death update

 +2       ; Update Reg Status based on DOD file 2

           DO LOOP^SPNDODCK(SPNDFN)

 +3       ; Updating Reg Status

           DO LOOP2^SPNDODCK(SPNDFN)

 +4        QUIT 

XMTDEL    ;

 +1        IF $DATA(^SPNL(154,SPNDFN,"XMT"))

               KILL ^SPNL(154,SPNDFN,"XMT")

 +2        QUIT