BTIUU1.m

BTIUU1 ; IHS/ITSC/LJF - MORE IHS UTILITY CALLS ;

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

 ;

VST(DA) ;EP -- returns visit date for document 

 Q $$GET1^DIQ(8925,DA,.03)

 ;

IVST(DA) ;EP; -- returns ien for visit for document

 Q $$GET1^DIQ(8925,DA,.03,"I")

 ;

CAT(DA) ;EP -- returns visit ser cat for document

 NEW X S X=$$IVST(DA) I X="" Q ""

 Q $$GET1^DIQ(9000010,X,.07,"I")

 ;

PAT(DA) ;EP -- returns patient name for document

 Q $$GET1^DIQ(8925,DA,.02)

 ;

IPAT(DA) ;EP; -- returns ien for patient for document

 Q $$GET1^DIQ(8925,DA,.02,"I")

 ;

PMV(VST,DFN) ;EP; -- returns pat move ien for visit

 NEW X,Y,Z

 S X=+$G(^AUPNVSIT(VST,0)) I X=0 Q ""

 S Y=$O(^DGPM("APTT1",DFN,(X-.0001))) I Y="" Q ""

 S Z=$O(^DGPM("APTT1",DFN,Y,0)) I Z="" Q ""

 I VST=$$GET1^DIQ(405,Z,.27,"I") Q Z

 Q ""

 ;

VNOTFIX(TIUDA) ;EP; -- updates visit pointer in v note if changed

 NEW X,Y,Z,DA,DR,DIE

 S X=$O(^AUPNVNOT("B",+TIUDA,0)) Q:X=""

 S Y=$P($G(^AUPNVNOT(X,0)),U,3) Q:Y=""

 S Z=$P($G(^TIU(8925,+TIUDA,0)),U,3) Q:Z=""  Q:Y=Z

 S DIE="^AUPNVNOT(",DA=X,DR=".03////"_Z D ^DIE

 Q

 ;

VA ;EP -- called to view a user's alerts

 NEW TIUSER,BTIU,DIR

 S TIUSER=$$READ^TIUU("PO^200:EMZQ") Q:+TIUSER<1

 K BTIU D USER^XQALERT("BTIU",+TIUSER)

 I $G(BTIU)=0 D  G VA

 . D MSG^BTIUU("No alerts found for "_$P(TIUSER,U,2),3,0,0)

 . D PAUSE^BTIUU

 D MSG^BTIUU(BTIU_" alerts found for "_$P(TIUSER,U,2)_":",3,0,0)

 S X=0 F  S X=$O(BTIU(X)) Q:'X  D

 . D MSG^BTIUU($J(X,3)_$E($P(BTIU(X),U),1,75),1,0,0)

 . I X#21=0 D PAUSE^BTIUU

 D PAUSE^BTIUU G VA

 Q

 ;

 ; -- archive copies of PAD and SP subrtns

PAD(DATA,LENGTH) ; -- SUBRTN to pad length of data

 Q $E(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)

 ;

SP(NUM) ; -- SUBRTN to pad spaces

 Q $$PAD(" ",NUM)

BTIUU1    ; IHS/ITSC/LJF - MORE IHS UTILITY CALLS ;

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

 +2       ;

VST(DA)   ;EP -- returns visit date for document 

 +1        QUIT $$GET1^DIQ(8925,DA,.03)

 +2       ;

IVST(DA)  ;EP; -- returns ien for visit for document

 +1        QUIT $$GET1^DIQ(8925,DA,.03,"I")

 +2       ;

CAT(DA)   ;EP -- returns visit ser cat for document

 +1        NEW X

           SET X=$$IVST(DA)

           IF X=""

               QUIT ""

 +2        QUIT $$GET1^DIQ(9000010,X,.07,"I")

 +3       ;

PAT(DA)   ;EP -- returns patient name for document

 +1        QUIT $$GET1^DIQ(8925,DA,.02)

 +2       ;

IPAT(DA)  ;EP; -- returns ien for patient for document

 +1        QUIT $$GET1^DIQ(8925,DA,.02,"I")

 +2       ;

PMV(VST,DFN) ;EP; -- returns pat move ien for visit

 +1        NEW X,Y,Z

 +2        SET X=+$GET(^AUPNVSIT(VST,0))

           IF X=0

               QUIT ""

 +3        SET Y=$ORDER(^DGPM("APTT1",DFN,(X-.0001)))

           IF Y=""

               QUIT ""

 +4        SET Z=$ORDER(^DGPM("APTT1",DFN,Y,0))

           IF Z=""

               QUIT ""

 +5        IF VST=$$GET1^DIQ(405,Z,.27,"I")

               QUIT Z

 +6        QUIT ""

 +7       ;

VNOTFIX(TIUDA) ;EP; -- updates visit pointer in v note if changed

 +1        NEW X,Y,Z,DA,DR,DIE

 +2        SET X=$ORDER(^AUPNVNOT("B",+TIUDA,0))

           IF X=""

               QUIT 

 +3        SET Y=$PIECE($GET(^AUPNVNOT(X,0)),U,3)

           IF Y=""

               QUIT 

 +4        SET Z=$PIECE($GET(^TIU(8925,+TIUDA,0)),U,3)

           IF Z=""

               QUIT 

           IF Y=Z

               QUIT 

 +5        SET DIE="^AUPNVNOT("

           SET DA=X

           SET DR=".03////"_Z

           DO ^DIE

 +6        QUIT 

 +7       ;

VA        ;EP -- called to view a user's alerts

 +1        NEW TIUSER,BTIU,DIR

 +2        SET TIUSER=$$READ^TIUU("PO^200:EMZQ")

           IF +TIUSER<1

               QUIT 

 +3        KILL BTIU

           DO USER^XQALERT("BTIU",+TIUSER)

 +4        IF $GET(BTIU)=0

               Begin DoDot:1

 +5                DO MSG^BTIUU("No alerts found for "_$PIECE(TIUSER,U,2),3,0,0)

 +6                DO PAUSE^BTIUU

               End DoDot:1

               GOTO VA

 +7        DO MSG^BTIUU(BTIU_" alerts found for "_$PIECE(TIUSER,U,2)_":",3,0,0)

 +8        SET X=0

           FOR 

               SET X=$ORDER(BTIU(X))

               IF 'X

                   QUIT 

               Begin DoDot:1

 +9                DO MSG^BTIUU($JUSTIFY(X,3)_$EXTRACT($PIECE(BTIU(X),U),1,75),1,0,0)

 +10               IF X#21=0

                       DO PAUSE^BTIUU

               End DoDot:1

 +11       DO PAUSE^BTIUU

           GOTO VA

 +12       QUIT 

 +13      ;

 +14      ; -- archive copies of PAD and SP subrtns

PAD(DATA,LENGTH) ; -- SUBRTN to pad length of data

 +1        QUIT $EXTRACT(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)

 +2       ;

SP(NUM)   ; -- SUBRTN to pad spaces

 +1        QUIT $$PAD(" ",NUM)