RAHLTCPU.m

RAHLTCPU ; HIRMFO/GJC,SG - Rad/Nuc Med HL7 TCP/IP Bridge utilities;10/10/07

 ;;5.0;Radiology/Nuclear Medicine;**84,94**;Mar 16, 1998;Build 9

 ;

LOCKX(RAERR,UNLOCK) ;lock/unlock the Rad/Nuc Med Patient record at one of two levels:

 ;If part of a printset (RAY3(25)=2) lock at the "DT" level

 ;Else lock at the "P" or case level

 ;Input: RADFN, RADTI, & RACNI are all assumed to be defined.

 ;       UNLOCK: if defined the function unlocks the encounter at the appropriate level

 ;Returns: RAERR (lock attempt only) if $D(RAERR)#2 lock failed, else lock successful

 N RANODE,RAY3 S RAY3=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),RAY3(25)=$P(RAY3,U,25)

 S RANODE=$S(RAY3(25)=2:$NA(^RADPT(RADFN,"DT",RADTI)),1:$NA(^RADPT(RADFN,"DT",RADTI,"P",RACNI)))

 I $G(UNLOCK)=1 L -@RANODE Q

 L +@RANODE:DILOCKTM E  S RAERR=$S(RAY3(25)=2:"Encounter",1:"Accession")_" locked within VistA"

 Q

 ;

LOCKR(RAERR) ;lock/unlock the report associated with an exam record/

 ;Input: RARPT is assumed to be defined

 ;Return: RAERR will be set if the lock attempt failed, else RAERR will not be defined

 I $D(RARPT)#2,($D(^RARPT(RARPT,0))#2) D

 .D LOCK^DILF($NA(^RARPT(RARPT))) ;$T=1 if lock attained, else 0

 .S:'$T RAERR="Report: "_$P($G(^RARPT(RARPT,0)),U)_" locked within VistA Radiology" Q

 E  S RAERR="The report record '"_$G(RARPT,"<UNDEFINED> RARPT")_"' is non-existent."

 Q

 ;

 ;

 ;##### ALLOCATES A NEW RECORD IN THE RAD/NUC MED REPORTS FILE (#74) AND LOCKS IT

 ; 

 ; Return Values

 ; =============

 ;           >0  IEN for the new record in the RAD/NUC MED REPORTS FILE (#74)

 ;

 ; Notes

 ; =====

 ;

 ; The placeholder for the new record (^RARPT(IEN) node) is LOCKed 

 ; by this function. It is responsibility of the caller to unlock the 

 ; record after it is created or the record creation is canceled.

 ;

NEWIEN() ;

 N IEN,NEWIEN,NODE

 S NEWIEN=0

 ;---

 F  D  Q:NEWIEN

 . S IEN=$O(^RARPT(" "),-1)+1

 . ;--- If the record already exists, skip it

 . S NODE=$NA(^RARPT(IEN))  Q:$D(@NODE)

 . ;--- Lock the placeholder in order to make sure that nobody

 . ;--- else is trying to allocate it at the same time.

 . D LOCK^DILF(NODE)  E  Q

 . ;--- Double check that the record has not been created after the

 . ;--- previous $D() check and the LOCK command (a race condition)

 . I $D(@NODE)  L -@NODE  Q

 . ;--- Success

 . S NEWIEN=IEN

 . Q

 ;---

 Q NEWIEN

RAHLTCPU  ; HIRMFO/GJC,SG - Rad/Nuc Med HL7 TCP/IP Bridge utilities;10/10/07

 +1       ;;5.0;Radiology/Nuclear Medicine;**84,94**;Mar 16, 1998;Build 9

 +2       ;

LOCKX(RAERR,UNLOCK) ;lock/unlock the Rad/Nuc Med Patient record at one of two levels:

 +1       ;If part of a printset (RAY3(25)=2) lock at the "DT" level

 +2       ;Else lock at the "P" or case level

 +3       ;Input: RADFN, RADTI, & RACNI are all assumed to be defined.

 +4       ;       UNLOCK: if defined the function unlocks the encounter at the appropriate level

 +5       ;Returns: RAERR (lock attempt only) if $D(RAERR)#2 lock failed, else lock successful

 +6        NEW RANODE,RAY3

           SET RAY3=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))

           SET RAY3(25)=$PIECE(RAY3,U,25)

 +7        SET RANODE=$SELECT(RAY3(25)=2:$NAME(^RADPT(RADFN,"DT",RADTI)),1:$NAME(^RADPT(RADFN,"DT",RADTI,"P",RACNI)))

 +8        IF $GET(UNLOCK)=1

               LOCK -@RANODE

               QUIT 

 +9        LOCK +@RANODE:DILOCKTM

          IF '$TEST

               SET RAERR=$SELECT(RAY3(25)=2:"Encounter",1:"Accession")_" locked within VistA"

 +10       QUIT 

 +11      ;

LOCKR(RAERR) ;lock/unlock the report associated with an exam record/

 +1       ;Input: RARPT is assumed to be defined

 +2       ;Return: RAERR will be set if the lock attempt failed, else RAERR will not be defined

 +3        IF $DATA(RARPT)#2

               IF ($DATA(^RARPT(RARPT,0))#2)

                   Begin DoDot:1

 +4       ;$T=1 if lock attained, else 0

                       DO LOCK^DILF($NAME(^RARPT(RARPT)))

 +5                    IF '$TEST

                           SET RAERR="Report: "_$PIECE($GET(^RARPT(RARPT,0)),U)_" locked within VistA Radiology"

                       QUIT 

                   End DoDot:1

 +6       IF '$TEST

               SET RAERR="The report record '"_$GET(RARPT,"<UNDEFINED> RARPT")_"' is non-existent."

 +7        QUIT 

 +8       ;

 +9       ;

 +10      ;##### ALLOCATES A NEW RECORD IN THE RAD/NUC MED REPORTS FILE (#74) AND LOCKS IT

 +11      ; 

 +12      ; Return Values

 +13      ; =============

 +14      ;           >0  IEN for the new record in the RAD/NUC MED REPORTS FILE (#74)

 +15      ;

 +16      ; Notes

 +17      ; =====

 +18      ;

 +19      ; The placeholder for the new record (^RARPT(IEN) node) is LOCKed 

 +20      ; by this function. It is responsibility of the caller to unlock the 

 +21      ; record after it is created or the record creation is canceled.

 +22      ;

NEWIEN()  ;

 +1        NEW IEN,NEWIEN,NODE

 +2        SET NEWIEN=0

 +3       ;---

 +4        FOR 

               Begin DoDot:1

 +5                SET IEN=$ORDER(^RARPT(" "),-1)+1

 +6       ;--- If the record already exists, skip it

 +7                SET NODE=$NAME(^RARPT(IEN))

                   IF $DATA(@NODE)

                       QUIT 

 +8       ;--- Lock the placeholder in order to make sure that nobody

 +9       ;--- else is trying to allocate it at the same time.

 +10               DO LOCK^DILF(NODE)

                  IF '$TEST

                       QUIT 

 +11      ;--- Double check that the record has not been created after the

 +12      ;--- previous $D() check and the LOCK command (a race condition)

 +13               IF $DATA(@NODE)

                       LOCK -@NODE

                       QUIT 

 +14      ;--- Success

 +15               SET NEWIEN=IEN

 +16               QUIT 

               End DoDot:1

               IF NEWIEN

                   QUIT 

 +17      ;---

 +18       QUIT NEWIEN