BPMU.m

BPMU ; IHS/OIT/LJF - IHS CODE CALLED BY MERGE FUNCTION

 ;;1.0;IHS PATIENT MERGE;;MAR 01, 2010

 ;

 Q

 ;

READ(TYPE,PROMPT,DEFAULT,HELP,SCREEN,DIRA) ;EP; calls reader, returns response

 NEW DIR,Y,DIRUT

 S DIR(0)=TYPE

 I $E(TYPE,1)="P",$P(TYPE,":",2)["L" S DLAYGO=+$P(TYPE,U,2)

 I $D(SCREEN) S DIR("S")=SCREEN

 I $G(PROMPT)]"" S DIR("A")=PROMPT

 I $G(DEFAULT)]"" S DIR("B")=DEFAULT

 I $D(HELP) S DIR("?")=HELP

 I $D(DIRA(1)) S Y=0 F  S Y=$O(DIRA(Y)) Q:Y=""  S DIR("A",Y)=DIRA(Y)

 D ^DIR

 Q Y

 ;

PAUSE ;EP; -- ask user to press return - no form feed

 NEW DIR Q:IOST'["C-"

 S DIR(0)="E",DIR("A")="Press ENTER to continue" D ^DIR

 Q

 ;

ZIS(X,BPMRTN,BPMDESC,BPMVAR,BPMDEV) ;EP; -- called to select device and send print

 K %ZIS,IOP,ZTIO

 I X="F" D     ;forced queuing; no user interaction

 . S ZTIO=BPMDEV,ZTDTH=$H

 E  D   Q:POP  I '$D(IO("Q")) D @BPMRTN Q

 . S %ZIS=X I $G(BPMDEV)]"" S %ZIS("B")=BPMDEV

 . D ^%ZIS

 ;

 K IO("Q") S ZTRTN=BPMRTN,ZTDESC=BPMDESC

 F I=1:1 S J=$P(BPMVAR,";",I) Q:J=""  S ZTSAVE(J)=""

 D ^%ZTLOAD K ZTSK D ^%ZISC

 Q

 ;

HRCN(PAT,SITE) ;EP; return chart number for patient at this site

 ;called by XDRMERGA

 I ('$G(PAT))!('$G(SITE)) Q "??"

 Q $P($G(^AUPNPAT(PAT,41,SITE,0)),U,2)

BPMU      ; IHS/OIT/LJF - IHS CODE CALLED BY MERGE FUNCTION

 +1       ;;1.0;IHS PATIENT MERGE;;MAR 01, 2010

 +2       ;

 +3        QUIT 

 +4       ;

READ(TYPE,PROMPT,DEFAULT,HELP,SCREEN,DIRA) ;EP; calls reader, returns response

 +1        NEW DIR,Y,DIRUT

 +2        SET DIR(0)=TYPE

 +3        IF $EXTRACT(TYPE,1)="P"

               IF $PIECE(TYPE,":",2)["L"

                   SET DLAYGO=+$PIECE(TYPE,U,2)

 +4        IF $DATA(SCREEN)

               SET DIR("S")=SCREEN

 +5        IF $GET(PROMPT)]""

               SET DIR("A")=PROMPT

 +6        IF $GET(DEFAULT)]""

               SET DIR("B")=DEFAULT

 +7        IF $DATA(HELP)

               SET DIR("?")=HELP

 +8        IF $DATA(DIRA(1))

               SET Y=0

               FOR 

                   SET Y=$ORDER(DIRA(Y))

                   IF Y=""

                       QUIT 

                   SET DIR("A",Y)=DIRA(Y)

 +9        DO ^DIR

 +10       QUIT Y

 +11      ;

PAUSE     ;EP; -- ask user to press return - no form feed

 +1        NEW DIR

           IF IOST'["C-"

               QUIT 

 +2        SET DIR(0)="E"

           SET DIR("A")="Press ENTER to continue"

           DO ^DIR

 +3        QUIT 

 +4       ;

ZIS(X,BPMRTN,BPMDESC,BPMVAR,BPMDEV) ;EP; -- called to select device and send print

 +1        KILL %ZIS,IOP,ZTIO

 +2       ;forced queuing; no user interaction

           IF X="F"

               Begin DoDot:1

 +3                SET ZTIO=BPMDEV

                   SET ZTDTH=$HOROLOG

               End DoDot:1

 +4       IF '$TEST

               Begin DoDot:1

 +5                SET %ZIS=X

                   IF $GET(BPMDEV)]""

                       SET %ZIS("B")=BPMDEV

 +6                DO ^%ZIS

               End DoDot:1

               IF POP

                   QUIT 

               IF '$DATA(IO("Q"))

                   DO @BPMRTN

                   QUIT 

 +7       ;

 +8        KILL IO("Q")

           SET ZTRTN=BPMRTN

           SET ZTDESC=BPMDESC

 +9        FOR I=1:1

               SET J=$PIECE(BPMVAR,";",I)

               IF J=""

                   QUIT 

               SET ZTSAVE(J)=""

 +10       DO ^%ZTLOAD

           KILL ZTSK

           DO ^%ZISC

 +11       QUIT 

 +12      ;

HRCN(PAT,SITE) ;EP; return chart number for patient at this site

 +1       ;called by XDRMERGA

 +2        IF ('$GET(PAT))!('$GET(SITE))

               QUIT "??"

 +3        QUIT $PIECE($GET(^AUPNPAT(PAT,41,SITE,0)),U,2)