- 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 ;
