NURAMHU.m

NURAMHU ;HIRMFO/MD-MANHOURS TMP ROUTINE ;3/89

 ;;4.0;NURSING SERVICE;**7**;Apr 25, 1997

EN1 ;SUBROUTINE TO LOOKUP EXISTING OR CREATE A NEW 213.4 FILE ENTRY

 S NURX=X,DA=$O(^NURSA(213.4,"B",X,0)) Q:DA>0

 S NDAT=$P(^NURSA(213.4,0),"^",3,4),DA=$P(NDAT,"^")+1,NCNT=$P(NDAT,"^",2)

 F DA=DA:1 L +(^NURSA(213.4,"B",NURX),^NURSA(213.4,DA,0)):0 Q:$T&'$D(^NURSA(213.4,DA,0))

 S NDA=$O(^NURSA(213.4,"B",NURX,0)) I NDA>0 S DA=NDA L -(^NURSA(213.4,"B",NURX),^NURSA(213.4,DA,0)) Q

 S ^NURSA(213.4,DA,0)=NURX,DIK="^NURSA(213.4," D IX1^DIK K DIK

 L -(^NURSA(213.4,"B",NURX),^NURSA(213.4,DA,0)) S $P(^NURSA(213.4,0),"^",3,4)=DA_"^"_(NCNT+1) K ZA,NCNT

 Q

EN2 ; PURGE DATA FROM MANHOURS MULTIPLE IN SITE PARAMETER FILE

 S %DT="",X="T-31" D ^%DT S NURCHK=+Y F DA=0:0 S DA=$O(^DIC(213.9,1,"MAN",DA)) Q:DA'>0  I $P(^DIC(213.9,1,"MAN",DA,0),"^")'>NURCHK S DA(1)=1,DIK="^DIC(213.9,DA(1),""MAN""," D ^DIK

 K NURCHK,DIK,%DT,DA

 Q

NURAMHU   ;HIRMFO/MD-MANHOURS TMP ROUTINE ;3/89

 +1       ;;4.0;NURSING SERVICE;**7**;Apr 25, 1997

EN1       ;SUBROUTINE TO LOOKUP EXISTING OR CREATE A NEW 213.4 FILE ENTRY

 +1        SET NURX=X

           SET DA=$ORDER(^NURSA(213.4,"B",X,0))

           IF DA>0

               QUIT 

 +2        SET NDAT=$PIECE(^NURSA(213.4,0),"^",3,4)

           SET DA=$PIECE(NDAT,"^")+1

           SET NCNT=$PIECE(NDAT,"^",2)

 +3        FOR DA=DA:1

               LOCK +(^NURSA(213.4,"B",NURX),^NURSA(213.4,DA,0)):0

               IF $TEST&'$DATA(^NURSA(213.4,DA,0))

                   QUIT 

 +4        SET NDA=$ORDER(^NURSA(213.4,"B",NURX,0))

           IF NDA>0

               SET DA=NDA

               LOCK -(^NURSA(213.4,"B",NURX),^NURSA(213.4,DA,0))

               QUIT 

 +5        SET ^NURSA(213.4,DA,0)=NURX

           SET DIK="^NURSA(213.4,"

           DO IX1^DIK

           KILL DIK

 +6        LOCK -(^NURSA(213.4,"B",NURX),^NURSA(213.4,DA,0))

           SET $PIECE(^NURSA(213.4,0),"^",3,4)=DA_"^"_(NCNT+1)

           KILL ZA,NCNT

 +7        QUIT 

EN2       ; PURGE DATA FROM MANHOURS MULTIPLE IN SITE PARAMETER FILE

 +1        SET %DT=""

           SET X="T-31"

           DO ^%DT

           SET NURCHK=+Y

           FOR DA=0:0

               SET DA=$ORDER(^DIC(213.9,1,"MAN",DA))

               IF DA'>0

                   QUIT 

               IF $PIECE(^DIC(213.9,1,"MAN",DA,0),"^")'>NURCHK

                   SET DA(1)=1

                   SET DIK="^DIC(213.9,DA(1),""MAN"","

                   DO ^DIK

 +2        KILL NURCHK,DIK,%DT,DA

 +3        QUIT