ACHSUD1 ; IHS/ITSC/PMF - SELECT HOSPITAL ORDER NUMBER ; [ 10/16/2001 8:16 AM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
;
K ACHSDIEN,DIC
A1 ;
W !!,"Hospital Order Number: "
W:ACHSHONN]"" ACHSHONN_"// "
D READ^ACHSFU
I Y?1"?".E D ORD G A1
Q:$D(DUOUT)!(Y="")
I Y=" ",$D(^DISV(DUZ,"ACHSUD1")) S Y=$G(^DISV(DUZ,"ACHSUD1")),Y=$E(Y,2)_"-"_$E(Y,3,99) W Y
I ACHSHONN]"",Y="@" W " Deleted" S (ACHSHON,ACHSHONN)="" G A1
G END:Y=""
F %=1:1:$L(Y) I $E(Y,%)?1P,$E(Y,%)'="-" S Y=$E(Y,1,%-1)_"-"_$E(Y,%+1,999)
F S F=$F(Y,"--") Q:'F S Y=$P(Y,"--")_"-"_$P(Y,"--",2,999)
S (N,F,C)="",P=$L(Y,"-")
I P>3 W *7," ??" G A1
S N=$P(Y,"-",P)
I P=3 S F=$P(Y,"-",2),C=+Y G A2
I P=2 S C=$P(Y,"-") S:$L(C)>1 F=C,C=""
A2 ;
S:C="" C=$E(ACHSACFY,4)
S:F="" F=ACHSFC
I $L(F)<3 S F=$E("000",1,3-$L(F))_F
I $L(N)<6 S N=$E("00000",1,5-$L(N))_N
S X="1"_C_N
K C,F,N,P
S DIC="^ACHSF("_DUZ(2)_",""D"",",DIC(0)="QZE",DIC("W")="W "" "",$P(^(0),U,14),""-"",ACHSFC,""-"",$P(^(0),U)"
D ^DIC
K DIC
G A1:Y<1
S ACHSHON=+Y,^DISV(DUZ,"ACHSUD1")=$P(Y,U,2)
END ;
Q
;
ORD ;
W !!," If The Patient Is Currently Being Hospitialized Under Contract",!," Enter The Order Number. Enter An '@' To Delete The Current Number.",!
Q:'$G(DFN)
ORDC ; Check Inpatient Hospital Order Number.
K O
S (A,E)=0
F S A=$O(^ACHSF(DUZ(2),"PB",DFN,A)) Q:'A I $D(^ACHSF(DUZ(2),"D",A,0)),$P(^(0),U,4)=1 S E=E+1,O(E)=+A_U_^(0)
G:'$D(O) ENDO
W !?8,"Doc #",?25,"Tran Date",!
F E=1:1 S A=$O(O(A)) Q:A<1 D
. W !,E,".",?5,$P(O(A),U,15),"-",ACHSFC,"-",$P(O(A),U,2),?25,$$FMTE^XLFDT($P(O(A),U,3))
. S $P(O(A),U,2)=$P(O(A),U,15)_"-"_ACHSFC_"-"_$P(O(A),U,2)
.Q
S Y=$$DIR^XBDIR("NO^1:"_(E-1),"Hospital Order Number","","","","",2)
G ENDO:$D(DUOUT)!$D(DTOUT)
I Y="" S (ACHSHON,ACHSHONN)="" G ENDO
S:$D(O(Y)) ACHSHON=+O(Y)
W " ",$P(O(Y),U,2)
S ACHSHONN=$P(O(Y),U,2)
ENDO ;
K A,E,O
Q
;
ACHSUD1 ; IHS/ITSC/PMF - SELECT HOSPITAL ORDER NUMBER ; [ 10/16/2001 8:16 AM ]
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
+2 ;
+3 KILL ACHSDIEN,DIC
A1 ;
+1 WRITE !!,"Hospital Order Number: "
+2 IF ACHSHONN]""
WRITE ACHSHONN_"// "
+3 DO READ^ACHSFU
+4 IF Y?1"?".E
DO ORD
GOTO A1
+5 IF $DATA(DUOUT)!(Y="")
QUIT
+6 IF Y=" "
IF $DATA(^DISV(DUZ,"ACHSUD1"))
SET Y=$GET(^DISV(DUZ,"ACHSUD1"))
SET Y=$EXTRACT(Y,2)_"-"_$EXTRACT(Y,3,99)
WRITE Y
+7 IF ACHSHONN]""
IF Y="@"
WRITE " Deleted"
SET (ACHSHON,ACHSHONN)=""
GOTO A1
+8 IF Y=""
GOTO END
+9 FOR %=1:1:$LENGTH(Y)
IF $EXTRACT(Y,%)?1P
IF $EXTRACT(Y,%)'="-"
SET Y=$EXTRACT(Y,1,%-1)_"-"_$EXTRACT(Y,%+1,999)
+10 FOR
SET F=$FIND(Y,"--")
IF 'F
QUIT
SET Y=$PIECE(Y,"--")_"-"_$PIECE(Y,"--",2,999)
+11 SET (N,F,C)=""
SET P=$LENGTH(Y,"-")
+12 IF P>3
WRITE *7," ??"
GOTO A1
+13 SET N=$PIECE(Y,"-",P)
+14 IF P=3
SET F=$PIECE(Y,"-",2)
SET C=+Y
GOTO A2
+15 IF P=2
SET C=$PIECE(Y,"-")
IF $LENGTH(C)>1
SET F=C
SET C=""
A2 ;
+1 IF C=""
SET C=$EXTRACT(ACHSACFY,4)
+2 IF F=""
SET F=ACHSFC
+3 IF $LENGTH(F)<3
SET F=$EXTRACT("000",1,3-$LENGTH(F))_F
+4 IF $LENGTH(N)<6
SET N=$EXTRACT("00000",1,5-$LENGTH(N))_N
+5 SET X="1"_C_N
+6 KILL C,F,N,P
+7 SET DIC="^ACHSF("_DUZ(2)_",""D"","
SET DIC(0)="QZE"
SET DIC("W")="W "" "",$P(^(0),U,14),""-"",ACHSFC,""-"",$P(^(0),U)"
+8 DO ^DIC
+9 KILL DIC
+10 IF Y<1
GOTO A1
+11 SET ACHSHON=+Y
SET ^DISV(DUZ,"ACHSUD1")=$PIECE(Y,U,2)
END ;
+1 QUIT
+2 ;
ORD ;
+1 WRITE !!," If The Patient Is Currently Being Hospitialized Under Contract",!," Enter The Order Number. Enter An '@' To Delete The Current Number.",!
+2 IF '$GET(DFN)
QUIT
ORDC ; Check Inpatient Hospital Order Number.
+1 KILL O
+2 SET (A,E)=0
+3 FOR
SET A=$ORDER(^ACHSF(DUZ(2),"PB",DFN,A))
IF 'A
QUIT
IF $DATA(^ACHSF(DUZ(2),"D",A,0))
IF $PIECE(^(0),U,4)=1
SET E=E+1
SET O(E)=+A_U_^(0)
+4 IF '$DATA(O)
GOTO ENDO
+5 WRITE !?8,"Doc #",?25,"Tran Date",!
+6 FOR E=1:1
SET A=$ORDER(O(A))
IF A<1
QUIT
Begin DoDot:1
+7 WRITE !,E,".",?5,$PIECE(O(A),U,15),"-",ACHSFC,"-",$PIECE(O(A),U,2),?25,$$FMTE^XLFDT($PIECE(O(A),U,3))
+8 SET $PIECE(O(A),U,2)=$PIECE(O(A),U,15)_"-"_ACHSFC_"-"_$PIECE(O(A),U,2)
+9 QUIT
End DoDot:1
+10 SET Y=$$DIR^XBDIR("NO^1:"_(E-1),"Hospital Order Number","","","","",2)
+11 IF $DATA(DUOUT)!$DATA(DTOUT)
GOTO ENDO
+12 IF Y=""
SET (ACHSHON,ACHSHONN)=""
GOTO ENDO
+13 IF $DATA(O(Y))
SET ACHSHON=+O(Y)
+14 WRITE " ",$PIECE(O(Y),U,2)
+15 SET ACHSHONN=$PIECE(O(Y),U,2)
ENDO ;
+1 KILL A,E,O
+2 QUIT
+3 ;
