BTIUPUTP.m

BTIUPUTP ; IHS/ITSC/LJF - IHS calls from ^TIUPUTPN ;

 ;;1.0;TEXT INTEGRATION UTILITIES;;NOV 04, 2004

 ;Code to find visit for document

 ;

 ; -- special call for op reports

 I $$PNAME^TIULC1(+$$DOCCLASS^TIULC1(TIUTYPE))="OPERATIVE REPORTS" D OPRPT Q

 ;

 ; -- special call for field trip notes

 I $P(TIUTYPE,U,2)="FIELD TRIP NOTE" D FIELD Q

 ;

 ; -- all other reports

 NEW TIUMODE S TIUMODE=$S($D(ZTQUEUED):0,1:1)

 D MAIN^TIUVSIT(.TIU,.DFN,TIUSSN,TIUEDT,TIULDT,"LAST",TIUMODE,TIULOC)

 Q

 ;

OPRPT ; -- find surgery visit for op report

 D GETSURG^BTIUVSIT(.TIUX,.DFN,TIUSSN,TIUEDT)

 ;

 ; -- if not found & user interaction, show list of visits for selection

 I 'TIUX,'$D(ZTQUEUED) D  I 'TIUX Q

 . S X1=TIUEDT,X2=-300 D C^%DTC S TIUEDT=X

 . D MAIN^TIUVSIT(.TIU,.DFN,TIUSSN,TIUEDT,TIULDT,"LAST",1,TIULOC,"",0)

 I 'TIUX Q

 ;

 ; -- set patient and visit variables needed for rest of upload link

 I $P($G(^AUPNVSIT(+TIUX,0)),U,5)'=DFN Q

 NEW TIUA D ENP^XBDIQ1(9000010,TIUX,".01;.07;.22","TIUA(","I")

 NEW TIUV S TIUV=TIUA(.22,"I")_";"_TIUA(.01,"I")_";"_TIUA(.07,"I")

 S BTIUVSIT=TIUX

 D PATVADPT^TIULV(.TIU,DFN,"",TIUV,$G(TIUSDC))

 Q

 ;

 ;

FIELD ; -- find patient and facility, make event visit

 NEW TIUN,TIUF,FOUND,QUIT,DOB

 S X=TIUDOB,%DT="P" D ^%DT Q:Y=-1  S DOB=Y  ;convert to internal

 S (FOUND,QUIT,TIUN,TIUX)=0

 ;

 ; -- find patient with hrcn and dob

 F  S TIUN=$O(^AUPNPAT("D",TIUSSN,TIUN)) Q:'TIUN  D     ;loop by hrcn

 . I $$GET1^DIQ(2,TIUN,.03,"I")'=DOB Q                  ;wrong date of birth

 . I FOUND S QUIT=1                                     ;>1 found

 . I '$D(^AUPNPAT(TIUN,41,DUZ(2),0)) Q                  ;must be patient at this facility

 . S FOUND=TIUN_U_$O(^AUPNPAT("D",TIUSSN,TIUN,0))       ;dfn_^_facility

 I QUIT Q                                               ;too many found

 I 'FOUND Q                                             ;none found

 ;

 ; -- create visit

 S DFN=$P(FOUND,U),TIUFAC=$P(FOUND,U,2)

 S X=TIUVDT,%DT="P" D ^%DT Q:Y=-1             ;visit date to internal

 S TIUX=$$EVENT(DFN,TIUFAC,Y)                 ;create event visit

 ;

 ; -- set visit and patient variables needed by TIU

 NEW TIUA D ENP^XBDIQ1(9000010,TIUX,".01;.07;.22","TIUA(","I")

 NEW TIUV S TIUV=TIUA(.22,"I")_";"_TIUA(.01,"I")_";"_TIUA(.07,"I")

 S BTIUVSIT=TIUX

 D PATVADPT^TIULV(.TIU,DFN,"",TIUV,$G(TIUSDC))

 Q

 ;

 ;

EVENT(APCDPAT,APCDLOC,APCDDATE) ;EP -- creates event type visit

 ; also called by ^BTIUCHLP

 K APCDALVR

 S APCDALVR("APCDADD")=1,APCDALVR("AUPNTALK")="",APCDALVR("APCDANE")=""

 S APCDALVR("APCDPAT")=APCDPAT

 S APCDALVR("APCDLOC")=APCDLOC

 S APCDALVR("APCDTYPE")="O"

 S APCDALVR("APCDCAT")="E"

 S APCDALVR("APCDDATE")=+APCDDATE

 S APCDALVR("APCDAUTO")=""

 D EN^APCDALV                    ;call PEP in PCC

 I $D(APCDALVR("APCDAFLG")) Q 0

 Q +APCDALVR("APCDVSIT")

BTIUPUTP  ; IHS/ITSC/LJF - IHS calls from ^TIUPUTPN ;

 +1       ;;1.0;TEXT INTEGRATION UTILITIES;;NOV 04, 2004

 +2       ;Code to find visit for document

 +3       ;

 +4       ; -- special call for op reports

 +5        IF $$PNAME^TIULC1(+$$DOCCLASS^TIULC1(TIUTYPE))="OPERATIVE REPORTS"

               DO OPRPT

               QUIT 

 +6       ;

 +7       ; -- special call for field trip notes

 +8        IF $PIECE(TIUTYPE,U,2)="FIELD TRIP NOTE"

               DO FIELD

               QUIT 

 +9       ;

 +10      ; -- all other reports

 +11       NEW TIUMODE

           SET TIUMODE=$SELECT($DATA(ZTQUEUED):0,1:1)

 +12       DO MAIN^TIUVSIT(.TIU,.DFN,TIUSSN,TIUEDT,TIULDT,"LAST",TIUMODE,TIULOC)

 +13       QUIT 

 +14      ;

OPRPT     ; -- find surgery visit for op report

 +1        DO GETSURG^BTIUVSIT(.TIUX,.DFN,TIUSSN,TIUEDT)

 +2       ;

 +3       ; -- if not found & user interaction, show list of visits for selection

 +4        IF 'TIUX

               IF '$DATA(ZTQUEUED)

                   Begin DoDot:1

 +5                    SET X1=TIUEDT

                       SET X2=-300

                       DO C^%DTC

                       SET TIUEDT=X

 +6                    DO MAIN^TIUVSIT(.TIU,.DFN,TIUSSN,TIUEDT,TIULDT,"LAST",1,TIULOC,"",0)

                   End DoDot:1

                   IF 'TIUX

                       QUIT 

 +7        IF 'TIUX

               QUIT 

 +8       ;

 +9       ; -- set patient and visit variables needed for rest of upload link

 +10       IF $PIECE($GET(^AUPNVSIT(+TIUX,0)),U,5)'=DFN

               QUIT 

 +11       NEW TIUA

           DO ENP^XBDIQ1(9000010,TIUX,".01;.07;.22","TIUA(","I")

 +12       NEW TIUV

           SET TIUV=TIUA(.22,"I")_";"_TIUA(.01,"I")_";"_TIUA(.07,"I")

 +13       SET BTIUVSIT=TIUX

 +14       DO PATVADPT^TIULV(.TIU,DFN,"",TIUV,$GET(TIUSDC))

 +15       QUIT 

 +16      ;

 +17      ;

FIELD     ; -- find patient and facility, make event visit

 +1        NEW TIUN,TIUF,FOUND,QUIT,DOB

 +2       ;convert to internal

           SET X=TIUDOB

           SET %DT="P"

           DO ^%DT

           IF Y=-1

               QUIT 

           SET DOB=Y

 +3        SET (FOUND,QUIT,TIUN,TIUX)=0

 +4       ;

 +5       ; -- find patient with hrcn and dob

 +6       ;loop by hrcn

           FOR 

               SET TIUN=$ORDER(^AUPNPAT("D",TIUSSN,TIUN))

               IF 'TIUN

                   QUIT 

               Begin DoDot:1

 +7       ;wrong date of birth

                   IF $$GET1^DIQ(2,TIUN,.03,"I")'=DOB

                       QUIT 

 +8       ;>1 found

                   IF FOUND

                       SET QUIT=1

 +9       ;must be patient at this facility

                   IF '$DATA(^AUPNPAT(TIUN,41,DUZ(2),0))

                       QUIT 

 +10      ;dfn_^_facility

                   SET FOUND=TIUN_U_$ORDER(^AUPNPAT("D",TIUSSN,TIUN,0))

               End DoDot:1

 +11      ;too many found

           IF QUIT

               QUIT 

 +12      ;none found

           IF 'FOUND

               QUIT 

 +13      ;

 +14      ; -- create visit

 +15       SET DFN=$PIECE(FOUND,U)

           SET TIUFAC=$PIECE(FOUND,U,2)

 +16      ;visit date to internal

           SET X=TIUVDT

           SET %DT="P"

           DO ^%DT

           IF Y=-1

               QUIT 

 +17      ;create event visit

           SET TIUX=$$EVENT(DFN,TIUFAC,Y)

 +18      ;

 +19      ; -- set visit and patient variables needed by TIU

 +20       NEW TIUA

           DO ENP^XBDIQ1(9000010,TIUX,".01;.07;.22","TIUA(","I")

 +21       NEW TIUV

           SET TIUV=TIUA(.22,"I")_";"_TIUA(.01,"I")_";"_TIUA(.07,"I")

 +22       SET BTIUVSIT=TIUX

 +23       DO PATVADPT^TIULV(.TIU,DFN,"",TIUV,$GET(TIUSDC))

 +24       QUIT 

 +25      ;

 +26      ;

EVENT(APCDPAT,APCDLOC,APCDDATE) ;EP -- creates event type visit

 +1       ; also called by ^BTIUCHLP

 +2        KILL APCDALVR

 +3        SET APCDALVR("APCDADD")=1

           SET APCDALVR("AUPNTALK")=""

           SET APCDALVR("APCDANE")=""

 +4        SET APCDALVR("APCDPAT")=APCDPAT

 +5        SET APCDALVR("APCDLOC")=APCDLOC

 +6        SET APCDALVR("APCDTYPE")="O"

 +7        SET APCDALVR("APCDCAT")="E"

 +8        SET APCDALVR("APCDDATE")=+APCDDATE

 +9        SET APCDALVR("APCDAUTO")=""

 +10      ;call PEP in PCC

           DO EN^APCDALV

 +11       IF $DATA(APCDALVR("APCDAFLG"))

               QUIT 0

 +12       QUIT +APCDALVR("APCDVSIT")