ACHSPAP2.m

ACHSPAP2 ; IHS/ITSC/PMF - MOVE MED DATA TO PATIENT CARE COMPONENT ; [ 12/06/2002  10:36 AM ]

 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**5**;JUN 11, 2001

 ;IHS/SET/GTH ACHS*3.1*5 12/06/2002 - Clarify PCC link messages.

 ;I '$$LINK^ACHSPAP1 W !,*7,"FIX THE PARAMETERS!" D RTRN^ACHS Q;IHS/SET/GTH ACHS*3.1*5 12/06/2002

 I '$$LINK^ACHSPAP1 W !,"No link to PCC : ",$P($$LINK^ACHSPAP1,U,2) D RTRN^ACHS Q  ;IHS/SET/GTH ACHS*3.1*5 12/06/2002

 ;

 W !!,"You'll be asked for a beginning and ending P.O. number."

 W !,"The medical data for P.O.'s included will be passed to the PCC."

 W !,"Press the ESCAPE key to stop.",!!

 Q:'$$DIR^XBDIR("E")

 ;

 N ACHSBPO,ACHSDIEN,ACHSDOCR,ACHSEPO

BPO ;

 S ACHSBPO=$$PO("Beginning")

 Q:$D(DUOUT)!$D(DTOUT)

EPO ;

 S ACHSEPO=$$PO("Ending")

 G BPO:$D(DUOUT)

 Q:$D(DTOUT)

 ;

 S ACHSBPO=("1"_$E(ACHSBPO)_$P(ACHSBPO,"-",3))-1

 S ACHSEPO="1"_$E(ACHSEPO)_$P(ACHSEPO,"-",3)

 ;

 I ACHSBPO>ACHSEPO W *7,!,"Beginning P.O. is later than the Ending P.O. ??" G BPO

 ;

 F  S ACHSBPO=$O(^ACHSF(DUZ(2),"D","B",ACHSBPO)) Q:'(ACHSBPO=+ACHSBPO)!(ACHSBPO>ACHSEPO)  D  Q:$$STOP

 . S ACHSDIEN=$O(^ACHSF(DUZ(2),"D","B",ACHSBPO,0))

 . S ACHSDOCR=$G(^ACHSF(DUZ(2),"D",ACHSDIEN,0))

 . Q:'$P(ACHSDOCR,U,22)

 . Q:'$D(^DPT($P(ACHSDOCR,U,22)))

 . W !!,"Processing ",$$NUM(ACHSBPO),", to end at ",$$NUM(ACHSEPO),".",!

 . D ^ACHSPAP

 . W !!,"Press the ESCAPE (Esc) key to stop...",!

 .Q

 ;

 D RTRN^ACHS

 Q

 ;

STOP() ;

 N X

 R *X:1

 I '(X=27) Q 0

 W *7

 F  R X:0 E  Q  ; Clear Keyboard buffer, if any.

 Q 1

 ;

NUM(X) ;

 Q $E(X,2)_"-"_ACHSFC_"-"_$E(X,3,7)

 ;

PO(ACHS) ;

 W !!!,"Select the ",ACHS," P.O. Number..."

 D ^ACHSUD

 I '$D(ACHSDIEN) S DUOUT="" Q ""

 Q $$DOC^ACHS(0,14)_"-"_$$FC^ACHS(DUZ(2))_"-"_$$DOC^ACHS(0,1)

 ;

ACHSPAP2  ; IHS/ITSC/PMF - MOVE MED DATA TO PATIENT CARE COMPONENT ; [ 12/06/2002  10:36 AM ]

 +1       ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**5**;JUN 11, 2001

 +2       ;IHS/SET/GTH ACHS*3.1*5 12/06/2002 - Clarify PCC link messages.

 +3       ;I '$$LINK^ACHSPAP1 W !,*7,"FIX THE PARAMETERS!" D RTRN^ACHS Q;IHS/SET/GTH ACHS*3.1*5 12/06/2002

 +4       ;IHS/SET/GTH ACHS*3.1*5 12/06/2002

           IF '$$LINK^ACHSPAP1

               WRITE !,"No link to PCC : ",$PIECE($$LINK^ACHSPAP1,U,2)

               DO RTRN^ACHS

               QUIT 

 +5       ;

 +6        WRITE !!,"You'll be asked for a beginning and ending P.O. number."

 +7        WRITE !,"The medical data for P.O.'s included will be passed to the PCC."

 +8        WRITE !,"Press the ESCAPE key to stop.",!!

 +9        IF '$$DIR^XBDIR("E")

               QUIT 

 +10      ;

 +11       NEW ACHSBPO,ACHSDIEN,ACHSDOCR,ACHSEPO

BPO       ;

 +1        SET ACHSBPO=$$PO("Beginning")

 +2        IF $DATA(DUOUT)!$DATA(DTOUT)

               QUIT 

EPO       ;

 +1        SET ACHSEPO=$$PO("Ending")

 +2        IF $DATA(DUOUT)

               GOTO BPO

 +3        IF $DATA(DTOUT)

               QUIT 

 +4       ;

 +5        SET ACHSBPO=("1"_$EXTRACT(ACHSBPO)_$PIECE(ACHSBPO,"-",3))-1

 +6        SET ACHSEPO="1"_$EXTRACT(ACHSEPO)_$PIECE(ACHSEPO,"-",3)

 +7       ;

 +8        IF ACHSBPO>ACHSEPO

               WRITE *7,!,"Beginning P.O. is later than the Ending P.O. ??"

               GOTO BPO

 +9       ;

 +10       FOR 

               SET ACHSBPO=$ORDER(^ACHSF(DUZ(2),"D","B",ACHSBPO))

               IF '(ACHSBPO=+ACHSBPO)!(ACHSBPO>ACHSEPO)

                   QUIT 

               Begin DoDot:1

 +11               SET ACHSDIEN=$ORDER(^ACHSF(DUZ(2),"D","B",ACHSBPO,0))

 +12               SET ACHSDOCR=$GET(^ACHSF(DUZ(2),"D",ACHSDIEN,0))

 +13               IF '$PIECE(ACHSDOCR,U,22)

                       QUIT 

 +14               IF '$DATA(^DPT($PIECE(ACHSDOCR,U,22)))

                       QUIT 

 +15               WRITE !!,"Processing ",$$NUM(ACHSBPO),", to end at ",$$NUM(ACHSEPO),".",!

 +16               DO ^ACHSPAP

 +17               WRITE !!,"Press the ESCAPE (Esc) key to stop...",!

 +18               QUIT 

               End DoDot:1

               IF $$STOP

                   QUIT 

 +19      ;

 +20       DO RTRN^ACHS

 +21       QUIT 

 +22      ;

STOP()    ;

 +1        NEW X

 +2        READ *X:1

 +3        IF '(X=27)

               QUIT 0

 +4        WRITE *7

 +5       ; Clear Keyboard buffer, if any.

           FOR 

               READ X:0

              IF '$TEST

                   QUIT 

 +6        QUIT 1

 +7       ;

NUM(X)    ;

 +1        QUIT $EXTRACT(X,2)_"-"_ACHSFC_"-"_$EXTRACT(X,3,7)

 +2       ;

PO(ACHS)  ;

 +1        WRITE !!!,"Select the ",ACHS," P.O. Number..."

 +2        DO ^ACHSUD

 +3        IF '$DATA(ACHSDIEN)

               SET DUOUT=""

               QUIT ""

 +4        QUIT $$DOC^ACHS(0,14)_"-"_$$FC^ACHS(DUZ(2))_"-"_$$DOC^ACHS(0,1)

 +5       ;