A1B2ADM ;ALB/MIR - Create ODS ADMISSION record from past admission record ;23 JAN 91
;;Version 1.55 (local for MAS v5 sites);;
;
D ON^A1B2UTL I 'A1B2ODS W !,"ODS software is not on...you can not use this option" G Q
PAT ;ask patient, check if ODS
W !! K DIC S DIC="^DPT(",DIC(0)="AEQMZ" D ^DIC G Q:Y'>0 S DFN=+Y
I $S('$D(^DPT(DFN,.32)):1,'$D(^DIC(21,+$P(^(.32),"^",3),0)):1,$P(^(0),"^",3)'=6:1,1:0) W !!?5,"Patient does not have a period of service of ODS" G PAT
S DIC("S")="I $P(^(0),""^"",2)=1,(^(0)>2910115),$S('$D(^(""ODS"")):1,'$P(^(""ODS""),""^"",4):1,1:0)" D EN^DGPMUTL S A1B2MVT=Y
I Y'>0 G PAT
;
ASK W !!,"Do you want to create an ODS ADMISSION entry for " S Y=$P(Y,"^",2) X ^DD("DD") W Y S %=2 D YN^DICN I $D(DTOUT) G Q
I %<0!(%=2) G PAT
I '% W !?2,"Enter 'Y'es if this admission was for care related to Operation",!?2,"Desert Shield. Otherwise, respond 'N'o." G ASK
ADD ;
S DGPMDA=+A1B2MVT,DGPMA=$P(A1B2MVT,"^",2) D ADM^DGPMVODS
S DIE="^DGPM(",DA=+A1B2MVT,DR="11500.01////1;11500.04////^S X=DGODSE" D ^DIE
S A1B2Y=11500.2,X=+DGODSE D UPD^A1B2XFR
W !,"Record Created"
Q K %,%Y,A1B2MVT,A1B2ODS,A1B2Y,DA,DFN,DGODSE,DGPMDA,DGPMA,DIC,DIE,DR,DTOUT,I,J,X,Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HA1B2ADM 1198 printed Dec 13, 2024@02:21:09 Page 2
A1B2ADM ;ALB/MIR - Create ODS ADMISSION record from past admission record ;23 JAN 91
+1 ;;Version 1.55 (local for MAS v5 sites);;
+2 ;
+3 DO ON^A1B2UTL
IF 'A1B2ODS
WRITE !,"ODS software is not on...you can not use this option"
GOTO Q
PAT ;ask patient, check if ODS
+1 WRITE !!
KILL DIC
SET DIC="^DPT("
SET DIC(0)="AEQMZ"
DO ^DIC
if Y'>0
GOTO Q
SET DFN=+Y
+2 IF $SELECT('$DATA(^DPT(DFN,.32)):1,'$DATA(^DIC(21,+$PIECE(^(.32),"^",3),0)):1,$PIECE(^(0),"^",3)'=6:1,1:0)
WRITE !!?5,"Patient does not have a period of service of ODS"
GOTO PAT
+3 SET DIC("S")="I $P(^(0),""^"",2)=1,(^(0)>2910115),$S('$D(^(""ODS"")):1,'$P(^(""ODS""),""^"",4):1,1:0)"
DO EN^DGPMUTL
SET A1B2MVT=Y
+4 IF Y'>0
GOTO PAT
+5 ;
ASK WRITE !!,"Do you want to create an ODS ADMISSION entry for "
SET Y=$PIECE(Y,"^",2)
XECUTE ^DD("DD")
WRITE Y
SET %=2
DO YN^DICN
IF $DATA(DTOUT)
GOTO Q
+1 IF %<0!(%=2)
GOTO PAT
+2 IF '%
WRITE !?2,"Enter 'Y'es if this admission was for care related to Operation",!?2,"Desert Shield. Otherwise, respond 'N'o."
GOTO ASK
ADD ;
+1 SET DGPMDA=+A1B2MVT
SET DGPMA=$PIECE(A1B2MVT,"^",2)
DO ADM^DGPMVODS
+2 SET DIE="^DGPM("
SET DA=+A1B2MVT
SET DR="11500.01////1;11500.04////^S X=DGODSE"
DO ^DIE
+3 SET A1B2Y=11500.2
SET X=+DGODSE
DO UPD^A1B2XFR
+4 WRITE !,"Record Created"
Q KILL %,%Y,A1B2MVT,A1B2ODS,A1B2Y,DA,DFN,DGODSE,DGPMDA,DGPMA,DIC,DIE,DR,DTOUT,I,J,X,Y
+1 QUIT
