PSGNE3.m

PSGNE3 ;BIR/CML3,MLM-DETERMINE DEFAULT FOR START & STOP TIMES ; 1/21/09 10:58am

 ;;5.0; INPATIENT MEDICATIONS ;**4,26,47,50,63,69,105,80,111,183,193**;16 DEC 97;Build 16

 ;

 ; Reference to ^PS(51.1 is supported by DBIA 2177

 ; Reference to ^PS(55 is supported by DBIA 2191

 ;

 N X1,X2,Y

NOW ;

 ;D NOW^%DTC S PSGDT=+$E(%,1,12),PSGNESD=$$ENSD(PSGSCH,PSGS0Y,PSGDT,PSGDT)

 S:'$D(PSGST) PSGST=""

 S PSGDT=$$DATE^PSJUTL2(),PSGNESD=$$ENSD($S(PSGST["P":"PRN",1:PSGSCH),PSGS0Y,PSGDT,PSGDT)

 ;

STOP ; exit when start date found

 K ET,F,FT,LT,NT,PSGNE3,TT G:$D(PSGOES)!$D(PSGODF) SF S PSGNESDO=$$ENDD^PSGMI(PSGNESD)

 Q

 ;

ENFD(PSGDT) ; find default stop date

 N X1,X2,X3DMIN,Y

SF I '$O(^PS(55,PSGP,5,"AUS",PSGDT)),'$D(^PS(53.1,"AC",PSGP)),+$G(^PS(55,PSGP,5.1)) S $P(^PS(55,PSGP,5.1),U)=""

 I $G(PSGOEA)="R",$P(PSJSYSW0,"^",4) D ENWALL(%,0,PSGP)

 S PSGNEFD="",PSGNEW=$S('$P(PSJSYSW0,U,4):0,+$G(^PS(55,PSGP,5.1))'>PSGDT:0,1:+$G(^PS(55,PSGP,5.1))) S:PSGNEW<PSGNESD PSGNEW=0

 I PSGNEW,($G(PSGOEA)="R") S X1=$P(%,"."),X2=3 D C^%DTC S PSGNEW=$S($P(X,".")_(PSGNESD#1)'>PSGNEW:PSGNEW,1:0)

 I PSGST="O" S PSGNEFD=$$ENOSD^PSJDCU(PSJSYSW0,PSGNESD,PSGP) I PSGNEFD]"" G OUT

 I PSGST'="O",PSGSCH]"",$S(PSGSCH="ONCE":1,PSGSCH="STAT":1,PSGSCH="ONE TIME":1,1:0)!($P($G(^PS(51.1,+$O(^PS(51.1,"B",PSGSCH,0)),0)),"^",5)="O") S PSGNEFD=$$ENOSD^PSJDCU(PSJSYSW0,PSGNESD,PSGP) I PSGNEFD]"" G OUT

 S X1=$P(PSGNESD,"."),X2=$S($P(PSJSYSW0,"^",3):+$P(PSJSYSW0,"^",3),1:14)

 D

  . ; *** ADDED VARIABLE AA TO CHECK FOR APPOINTMENT and CLINIC

  . ; *** psi 06 082 - RDC 08/2006

 . N A,AA,B

 . Q:'$D(PSGORD)  S A=""

 . I PSGORD["P" S A=$G(^PS(53.1,+PSGORD,"DSS"))

 . I PSGORD["U" S A=$G(^PS(55,PSGP,5,+PSGORD,8))

 . I PSGORD["I" S A=$G(^PS(55,PSGP,"IV",+PSGORD,"DSS"))

 . S A=$P(A,"^"),AA=$P(A,"^",2) I A,AA S X2=14 I $D(^PS(53.46,"B",A)) S B=$O(^PS(53.46,"B",A,"")),X2=$P(^PS(53.46,B,0),"^",2) I X2="" S X2=14

 D C^%DTC

 I $G(PSGNEDFD) I $S($P(PSGNEDFD,"^")["L":PSGS0XT!PSGS0Y,1:1) D DFD

 ;I PSGNEW S PSGNEFD=PSGNEW G OUT

 I $G(PSGORD),$G(PSGFD) S X3DMIN=$$GETDUR^PSJLIVMD(PSGP,+$G(PSGORD),$S($G(PSGORD)["P":"P",$G(PSGORD)["V":"IV",1:5),1) I X3DMIN]"" D  I PSGNEFD]"" G OUT

 . S X3DMIN=$$DURMIN^PSJLIVMD(X3DMIN) I $G(X3DMIN) S PSGNEFD=$$FMADD^XLFDT(PSGNESD,,,X3DMIN)

 S X=+(X_$S($P(PSJSYSW0,"^",7):"."_$P(PSJSYSW0,"^",7),1:(PSGNESD#1)))

 S PSGNEFD=$S('PSGNEFD:X,X<PSGNEFD:X,1:PSGNEFD) I PSGNEW,(PSGNEW<PSGNEFD),$P(PSJSYSW0,U,4) D

 . I $G(PSGORD),$G(PSGRDTX) I PSGORD=$P(PSGRDTX,U,4),PSGNEW<PSGRDTX Q   ; Requested Start is after Stop

 . S PSGNEFD=PSGNEW

 ;

OUT ;

 S:$G(PSGSDX) PSGNESD=PSGSDX S:$G(PSGFDX) PSGNEFD=PSGFDX

 I '$D(PSGODF),'$D(PSGOES) S PSGNEFDO=$$ENDD^PSGMI(PSGNEFD)

 K PSGDL,PSGNEW Q

 ;

DFD ;

 I $P(PSGNEDFD,"^")["D" S X1=$P(PSGNESD,"."),X2=+PSGNEDFD D C^%DTC S X=+(X_"."_$S($P(PSJSYSW0,"^",7):$P(PSJSYSW0,"^",7),1:$P(PSGNESD,".",2)))

 I $P(PSGNEDFD,"^")["L" S PSGDL=+PSGNEDFD D EN1^PSGDL

 S PSGNEFD=$S(PSGNEW<X&PSGNEW:PSGNEW,1:X) Q:$P(PSGNEDFD,"^")'["D"!'$P(PSJSYSW0,"^",4)!PSGNEW

 Q

 ;

ENOR ;

 K PSGOES,PSGODF S X=$P($G(^PS(53.1,DA,2)),"^")

 S $P(^PS(53.1,DA,0),"^",7)=$S(X="PRN":"P",X="ONCE":"O",X="STAT":"O",X="ONE TIME":"O",X="ON CALL":"OC",$P(PSGNEDFD,"^",3)]"":$P(PSGNEDFD,"^",3),1:"C") D PSGNE3 S X=PSGNESD

 Q

 ;

ENSET0(DFN) ; Set "0" node and build xrefs for entries found without one.

 N DA,DIK S ^PS(55,DFN,0)=DFN,DIK="^PS(55,",DIK(1)=.01,DA=DFN D EN^DIK

 S $P(^PS(55,DFN,5.1),"^",11)=2 ; Mark as converted for POE

 Q

 ;

ENWALL(SD,FD,DFN) ; Update default stop date if appropriate.

 N WALL,NWALL,X1,X2,X3

 D NOW^%DTC S X3=%

 S WALL=+$G(^PS(55,DFN,5.1)),X1=$P(SD,"."),X2=3 D C^%DTC I +(X_"."_$P(SD,".",2))'>+WALL Q

 S X1=$P(X3,"."),X2=$S($P(PSJSYSW0,U,3):+$P(PSJSYSW0,U,3),1:14) D C^%DTC

 S NWALL=X_$S($P(PSJSYSW0,U,7):"."_$P(PSJSYSW0,U,7),1:SD#1)

 S $P(^PS(55,DFN,5.1),U)=+$S(FD>NWALL:FD,1:NWALL)

 Q

 ;

ENSD(SCH,AT,LI,OSD) ;Find start date/time for orders.

 ;SCH=schedule,AT=admin times,LI=login date/time,OSD=Renewed orders start

 I $G(APPT),$G(PSGORD)["P" S XD=$$DATE2^PSJUTL2(APPT) Q XD

 N X,OSDLI D

 .I $L(LI)<13 S X=LI Q

 .I $L(LI)=14 S X=$E(LI,13,14) S:X>29 X=$E(LI,1,12)_5 S:X'>29 X=$E(LI,1,12)_1 Q

 .I $L(LI)=13 S X=$E(LI,13)_0 S:X>29 X=$E(LI,1,12)_5 S:X'>29 X=$E(LI,1,12)_1 Q

 I $G(LI) S:(LI=$G(OSD)) OSDLI=1

 S LI=+$FN(X,"",4) I '$P(LI,".",2) S LI=$$FMADD^XLFDT(LI,-1,0,0,0)_.24

 I $G(OSDLI) S OSD=LI K OSDLI

 ;S LI=+$E(LI,1,12) I '$P(LI,".",2) S LI=$$FMADD^XLFDT(LI,-1,0,0,0)_.24

 I $G(PSJSYSW0)=""!($P(PSJSYSW0,U,5)=2) Q LI

 S:SCH["PRN" AT=""

 N INT,PSG S:(SCH'["PRN"&(SCH'?1"Q".N1"H")&(LI'=OSD)&('AT)&($G(PSGST)'="O")) AT=$E(OSD,9,10) S OSD=$E(OSD,1,10)

 S INT=$S(SCH="QD":24,SCH="QOD":48,SCH="QH":1,SCH?1"Q".N1"D":(+$P(SCH,"Q",2)*24),SCH?1"Q".N1"H":+$P(SCH,"Q",2),LI=OSD:24,1:24)

 S:INT=24 OSD=$$FMADD^XLFDT(LI,0,-INT,0,0)

 I 'AT,INT>23 S:$P(PSJSYSW0,U,5)!($E(LI,11,12)>30) AT=$E($$FMADD^XLFDT(LI,0,1,0,0),9,10) S:AT="00" AT=24 S:'AT AT=$E(LI,9,10)

 I SCH?1"Q".N1"H",'AT S ND=OSD,PSG(+ND)="" S:(INT>24)&('$G(PSJREN)) INT=24 S DAYS=INT\24,HRS=(-INT\24*24+INT) F  S ND=$$FMADD^XLFDT(ND,DAYS,HRS),PSG(+ND)="" Q:ND>LI

 Q:INT=24&'$L(AT,"-") $E(LI,1,8)_AT

 ;Q:$P(PSJSYSW0,U,5)&(AT=23) $E(LI,1,8)_24

 I '$O(PSG(LI)) S X=$S(OSD>1:OSD,LI>1:LI,1:$$DATE^PSJUTL2) D

 .F  S ND=X D  Q:ND>LI  S:(INT>24)&('$G(PSJREN)) INT=24 S DAYS=INT\24,HRS=(-INT\24*24+INT) S X=$$FMADD^XLFDT($S($P(ND,".",2)=24:$P(ND,".")_".23",1:ND),DAYS,HRS) S:$P(X,".")'>$P(ND,".") X=$$FMADD^XLFDT(X,1,0,0,0)

 ..F Y=1:1 S AT1=$P(AT,"-",Y) Q:'AT1  S ND=ND\1_"."_AT1,PSG(+ND)=""

 Q:$P(PSJSYSW0,U,5) $O(PSG(LI))

 S INT="" F ND=0:0 S ND=$O(PSG(ND)) S X=$$FMDIFF^XLFDT(LI,ND,2) S:X<0 X=-X Q:INT&(X'<INT)  S INT=+X,OND=ND Q:INT=0

 Q $S($G(OND):OND,1:LI)  ;Use login time if OND is null PSJ*5*193

PSGNE3    ;BIR/CML3,MLM-DETERMINE DEFAULT FOR START & STOP TIMES ; 1/21/09 10:58am

 +1       ;;5.0; INPATIENT MEDICATIONS ;**4,26,47,50,63,69,105,80,111,183,193**;16 DEC 97;Build 16

 +2       ;

 +3       ; Reference to ^PS(51.1 is supported by DBIA 2177

 +4       ; Reference to ^PS(55 is supported by DBIA 2191

 +5       ;

 +6        NEW X1,X2,Y

NOW       ;

 +1       ;D NOW^%DTC S PSGDT=+$E(%,1,12),PSGNESD=$$ENSD(PSGSCH,PSGS0Y,PSGDT,PSGDT)

 +2        IF '$DATA(PSGST)

               SET PSGST=""

 +3        SET PSGDT=$$DATE^PSJUTL2()

           SET PSGNESD=$$ENSD($SELECT(PSGST["P":"PRN",1:PSGSCH),PSGS0Y,PSGDT,PSGDT)

 +4       ;

STOP      ; exit when start date found

 +1        KILL ET,F,FT,LT,NT,PSGNE3,TT

           IF $DATA(PSGOES)!$DATA(PSGODF)

               GOTO SF

           SET PSGNESDO=$$ENDD^PSGMI(PSGNESD)

 +2        QUIT 

 +3       ;

ENFD(PSGDT) ; find default stop date

 +1        NEW X1,X2,X3DMIN,Y

SF         IF '$ORDER(^PS(55,PSGP,5,"AUS",PSGDT))

               IF '$DATA(^PS(53.1,"AC",PSGP))

                   IF +$GET(^PS(55,PSGP,5.1))

                       SET $PIECE(^PS(55,PSGP,5.1),U)=""

 +1        IF $GET(PSGOEA)="R"

               IF $PIECE(PSJSYSW0,"^",4)

                   DO ENWALL(%,0,PSGP)

 +2        SET PSGNEFD=""

           SET PSGNEW=$SELECT('$PIECE(PSJSYSW0,U,4):0,+$GET(^PS(55,PSGP,5.1))'>PSGDT:0,1:+$GET(^PS(55,PSGP,5.1)))

           IF PSGNEW<PSGNESD

               SET PSGNEW=0

 +3        IF PSGNEW

               IF ($GET(PSGOEA)="R")

                   SET X1=$PIECE(%,".")

                   SET X2=3

                   DO C^%DTC

                   SET PSGNEW=$SELECT($PIECE(X,".")_(PSGNESD#1)'>PSGNEW:PSGNEW,1:0)

 +4        IF PSGST="O"

               SET PSGNEFD=$$ENOSD^PSJDCU(PSJSYSW0,PSGNESD,PSGP)

               IF PSGNEFD]""

                   GOTO OUT

 +5        IF PSGST'="O"

               IF PSGSCH]""

                   IF $SELECT(PSGSCH="ONCE":1,PSGSCH="STAT":1,PSGSCH="ONE TIME":1,1:0)!($PIECE($GET(^PS(51.1,+$ORDER(^PS(51.1,"B",PSGSCH,0)),0)),"^",5)="O")

                       SET PSGNEFD=$$ENOSD^PSJDCU(PSJSYSW0,PSGNESD,PSGP)

                       IF PSGNEFD]""

                           GOTO OUT

 +6        SET X1=$PIECE(PSGNESD,".")

           SET X2=$SELECT($PIECE(PSJSYSW0,"^",3):+$PIECE(PSJSYSW0,"^",3),1:14)

 +7        Begin DoDot:1

 +8       ; *** ADDED VARIABLE AA TO CHECK FOR APPOINTMENT and CLINIC

 +9       ; *** psi 06 082 - RDC 08/2006

 +10           NEW A,AA,B

 +11           IF '$DATA(PSGORD)

                   QUIT 

               SET A=""

 +12           IF PSGORD["P"

                   SET A=$GET(^PS(53.1,+PSGORD,"DSS"))

 +13           IF PSGORD["U"

                   SET A=$GET(^PS(55,PSGP,5,+PSGORD,8))

 +14           IF PSGORD["I"

                   SET A=$GET(^PS(55,PSGP,"IV",+PSGORD,"DSS"))

 +15           SET A=$PIECE(A,"^")

               SET AA=$PIECE(A,"^",2)

               IF A

                   IF AA

                       SET X2=14

                       IF $DATA(^PS(53.46,"B",A))

                           SET B=$ORDER(^PS(53.46,"B",A,""))

                           SET X2=$PIECE(^PS(53.46,B,0),"^",2)

                           IF X2=""

                               SET X2=14

           End DoDot:1

 +16       DO C^%DTC

 +17       IF $GET(PSGNEDFD)

               IF $SELECT($PIECE(PSGNEDFD,"^")["L":PSGS0XT!PSGS0Y,1:1)

                   DO DFD

 +18      ;I PSGNEW S PSGNEFD=PSGNEW G OUT

 +19       IF $GET(PSGORD)

               IF $GET(PSGFD)

                   SET X3DMIN=$$GETDUR^PSJLIVMD(PSGP,+$GET(PSGORD),$SELECT($GET(PSGORD)["P":"P",$GET(PSGORD)["V":"IV",1:5),1)

                   IF X3DMIN]""

                       Begin DoDot:1

 +20                       SET X3DMIN=$$DURMIN^PSJLIVMD(X3DMIN)

                           IF $GET(X3DMIN)

                               SET PSGNEFD=$$FMADD^XLFDT(PSGNESD,,,X3DMIN)

                       End DoDot:1

                       IF PSGNEFD]""

                           GOTO OUT

 +21       SET X=+(X_$SELECT($PIECE(PSJSYSW0,"^",7):"."_$PIECE(PSJSYSW0,"^",7),1:(PSGNESD#1)))

 +22       SET PSGNEFD=$SELECT('PSGNEFD:X,X<PSGNEFD:X,1:PSGNEFD)

           IF PSGNEW

               IF (PSGNEW<PSGNEFD)

                   IF $PIECE(PSJSYSW0,U,4)

                       Begin DoDot:1

 +23      ; Requested Start is after Stop

                           IF $GET(PSGORD)

                               IF $GET(PSGRDTX)

                                   IF PSGORD=$PIECE(PSGRDTX,U,4)

                                       IF PSGNEW<PSGRDTX

                                           QUIT 

 +24                       SET PSGNEFD=PSGNEW

                       End DoDot:1

 +25      ;

OUT       ;

 +1        IF $GET(PSGSDX)

               SET PSGNESD=PSGSDX

           IF $GET(PSGFDX)

               SET PSGNEFD=PSGFDX

 +2        IF '$DATA(PSGODF)

               IF '$DATA(PSGOES)

                   SET PSGNEFDO=$$ENDD^PSGMI(PSGNEFD)

 +3        KILL PSGDL,PSGNEW

           QUIT 

 +4       ;

DFD       ;

 +1        IF $PIECE(PSGNEDFD,"^")["D"

               SET X1=$PIECE(PSGNESD,".")

               SET X2=+PSGNEDFD

               DO C^%DTC

               SET X=+(X_"."_$SELECT($PIECE(PSJSYSW0,"^",7):$PIECE(PSJSYSW0,"^",7),1:$PIECE(PSGNESD,".",2)))

 +2        IF $PIECE(PSGNEDFD,"^")["L"

               SET PSGDL=+PSGNEDFD

               DO EN1^PSGDL

 +3        SET PSGNEFD=$SELECT(PSGNEW<X&PSGNEW:PSGNEW,1:X)

           IF $PIECE(PSGNEDFD,"^")'["D"!'$PIECE(PSJSYSW0,"^",4)!PSGNEW

               QUIT 

 +4        QUIT 

 +5       ;

ENOR      ;

 +1        KILL PSGOES,PSGODF

           SET X=$PIECE($GET(^PS(53.1,DA,2)),"^")

 +2        SET $PIECE(^PS(53.1,DA,0),"^",7)=$SELECT(X="PRN":"P",X="ONCE":"O",X="STAT":"O",X="ONE TIME":"O",X="ON CALL":"OC",$PIECE(PSGNEDFD,"^",3)]"":$PIECE(PSGNEDFD,"^",3),1:"C")

           DO PSGNE3

           SET X=PSGNESD

 +3        QUIT 

 +4       ;

ENSET0(DFN) ; Set "0" node and build xrefs for entries found without one.

 +1        NEW DA,DIK

           SET ^PS(55,DFN,0)=DFN

           SET DIK="^PS(55,"

           SET DIK(1)=.01

           SET DA=DFN

           DO EN^DIK

 +2       ; Mark as converted for POE

           SET $PIECE(^PS(55,DFN,5.1),"^",11)=2

 +3        QUIT 

 +4       ;

ENWALL(SD,FD,DFN) ; Update default stop date if appropriate.

 +1        NEW WALL,NWALL,X1,X2,X3

 +2        DO NOW^%DTC

           SET X3=%

 +3        SET WALL=+$GET(^PS(55,DFN,5.1))

           SET X1=$PIECE(SD,".")

           SET X2=3

           DO C^%DTC

           IF +(X_"."_$PIECE(SD,".",2))'>+WALL

               QUIT 

 +4        SET X1=$PIECE(X3,".")

           SET X2=$SELECT($PIECE(PSJSYSW0,U,3):+$PIECE(PSJSYSW0,U,3),1:14)

           DO C^%DTC

 +5        SET NWALL=X_$SELECT($PIECE(PSJSYSW0,U,7):"."_$PIECE(PSJSYSW0,U,7),1:SD#1)

 +6        SET $PIECE(^PS(55,DFN,5.1),U)=+$SELECT(FD>NWALL:FD,1:NWALL)

 +7        QUIT 

 +8       ;

ENSD(SCH,AT,LI,OSD) ;Find start date/time for orders.

 +1       ;SCH=schedule,AT=admin times,LI=login date/time,OSD=Renewed orders start

 +2        IF $GET(APPT)

               IF $GET(PSGORD)["P"

                   SET XD=$$DATE2^PSJUTL2(APPT)

                   QUIT XD

 +3        NEW X,OSDLI

           Begin DoDot:1

 +4            IF $LENGTH(LI)<13

                   SET X=LI

                   QUIT 

 +5            IF $LENGTH(LI)=14

                   SET X=$EXTRACT(LI,13,14)

                   IF X>29

                       SET X=$EXTRACT(LI,1,12)_5

                   IF X'>29

                       SET X=$EXTRACT(LI,1,12)_1

                   QUIT 

 +6            IF $LENGTH(LI)=13

                   SET X=$EXTRACT(LI,13)_0

                   IF X>29

                       SET X=$EXTRACT(LI,1,12)_5

                   IF X'>29

                       SET X=$EXTRACT(LI,1,12)_1

                   QUIT 

           End DoDot:1

 +7        IF $GET(LI)

               IF (LI=$GET(OSD))

                   SET OSDLI=1

 +8        SET LI=+$FNUMBER(X,"",4)

           IF '$PIECE(LI,".",2)

               SET LI=$$FMADD^XLFDT(LI,-1,0,0,0)_.24

 +9        IF $GET(OSDLI)

               SET OSD=LI

               KILL OSDLI

 +10      ;S LI=+$E(LI,1,12) I '$P(LI,".",2) S LI=$$FMADD^XLFDT(LI,-1,0,0,0)_.24

 +11       IF $GET(PSJSYSW0)=""!($PIECE(PSJSYSW0,U,5)=2)

               QUIT LI

 +12       IF SCH["PRN"

               SET AT=""

 +13       NEW INT,PSG

           IF (SCH'["PRN"&(SCH'?1"Q".N1"H")&(LI'=OSD)&('AT)&($GET(PSGST)'="O"))

               SET AT=$EXTRACT(OSD,9,10)

           SET OSD=$EXTRACT(OSD,1,10)

 +14       SET INT=$SELECT(SCH="QD":24,SCH="QOD":48,SCH="QH":1,SCH?1"Q".N1"D":(+$PIECE(SCH,"Q",2)*24),SCH?1"Q".N1"H":+$PIECE(SCH,"Q",2),LI=OSD:24,1:24)

 +15       IF INT=24

               SET OSD=$$FMADD^XLFDT(LI,0,-INT,0,0)

 +16       IF 'AT

               IF INT>23

                   IF $PIECE(PSJSYSW0,U,5)!($EXTRACT(LI,11,12)>30)

                       SET AT=$EXTRACT($$FMADD^XLFDT(LI,0,1,0,0),9,10)

                   IF AT="00"

                       SET AT=24

                   IF 'AT

                       SET AT=$EXTRACT(LI,9,10)

 +17       IF SCH?1"Q".N1"H"

               IF 'AT

                   SET ND=OSD

                   SET PSG(+ND)=""

                   IF (INT>24)&('$GET(PSJREN))

                       SET INT=24

                   SET DAYS=INT\24

                   SET HRS=(-INT\24*24+INT)

                   FOR 

                       SET ND=$$FMADD^XLFDT(ND,DAYS,HRS)

                       SET PSG(+ND)=""

                       IF ND>LI

                           QUIT 

 +18       IF INT=24&'$LENGTH(AT,"-")

               QUIT $EXTRACT(LI,1,8)_AT

 +19      ;Q:$P(PSJSYSW0,U,5)&(AT=23) $E(LI,1,8)_24

 +20       IF '$ORDER(PSG(LI))

               SET X=$SELECT(OSD>1:OSD,LI>1:LI,1:$$DATE^PSJUTL2)

               Begin DoDot:1

 +21               FOR 

                       SET ND=X

                       Begin DoDot:2

 +22                       FOR Y=1:1

                               SET AT1=$PIECE(AT,"-",Y)

                               IF 'AT1

                                   QUIT 

                               SET ND=ND\1_"."_AT1

                               SET PSG(+ND)=""

                       End DoDot:2

                       IF ND>LI

                           QUIT 

                       IF (INT>24)&('$GET(PSJREN))

                           SET INT=24

                       SET DAYS=INT\24

                       SET HRS=(-INT\24*24+INT)

                       SET X=$$FMADD^XLFDT($SELECT($PIECE(ND,".",2)=24:$PIECE(ND,".")_".23",1:ND),DAYS,HRS)

                       IF $PIECE(X,".")'>$PIECE(ND,".")

                           SET X=$$FMADD^XLFDT(X,1,0,0,0)

               End DoDot:1

 +23       IF $PIECE(PSJSYSW0,U,5)

               QUIT $ORDER(PSG(LI))

 +24       SET INT=""

           FOR ND=0:0

               SET ND=$ORDER(PSG(ND))

               SET X=$$FMDIFF^XLFDT(LI,ND,2)

               IF X<0

                   SET X=-X

               IF INT&(X'<INT)

                   QUIT 

               SET INT=+X

               SET OND=ND

               IF INT=0

                   QUIT 

 +25      ;Use login time if OND is null PSJ*5*193

           QUIT $SELECT($GET(OND):OND,1:LI)