DGPTFM5 ;ALB/MTK/ADL - PTF ENTRY/EDIT-3 ; 11 MAR 91 15:15
;;5.3;Registration;**510,606,1015**;Aug 13, 1993;Build 21
;;ADL;Update for CSV Project;;Mar 26, 2003
;
S DGZS0=DGZS0+1
EN D MOB:'$D(S) S S(DGZS0,1)=$S($D(S(DGZS0,1)):S(DGZS0,1),1:"") G NEXM:S(DGZS0,1)="" S (S1,S(DGZS0))=$S($D(^DGPT(PTF,"S",S(DGZS0,1),0)):^DGPT(PTF,"S",S(DGZS0,1),0),1:"")
WR W @IOF,HEAD,?72 S Z="<401-"_DGZS0_">" D Z^DGPTFM
S L=+S(DGZS0),Y=L D D^DGPTUTL W !! S Z=1 D Z W "Date of Surg: " S Z=Y,Z1=28 D Z1 W "Chief Surg: " S L=";"_$P(^DD(45.01,4,0),U,3),L1=";"_$P(S1,U,4)_":" W $P($P(L,L1,2),";",1)
W !," Anesth Tech: " S L=";"_$P(^DD(45.01,6,0),U,3),L1=";"_$P(S1,U,6)_":" W $P($P(L,L1,2),";",1),?45,"First Asst: " S L=";"_$P(^DD(45.01,5,0),U,3),L1=";"_$P(S1,U,5)_":" W $P($P(L,L1,2),";",1)
W !," Source of pay: " S L=";"_$P(^DD(45.01,7,0),U,3),L1=";"_$P(S1,U,7)_":" W $P($P(L,L1,2),";",1)
W ?46,"Surg spec: ",$E($S($D(^DIC(45.3,+$P(S1,U,3),0)):$P(^(0),U,2),1:""),1,23)
W !! S Z=2 D Z W " Surg/pro: " F I=1:1:5 S L=$P(S1,U,I+7) I L'="" S DGPTTMP=$$ICDOP^ICDCODE(+L,$$GETDATE^ICDGTDRG(PTF)) D
. W $S(+DGPTTMP>0&($P(DGPTTMP,U,10)):$P(DGPTTMP,U,5)_" ("_$P(DGPTTMP,U,2)_")",1:"**********-"_L),!?17
;-- kidney transplant source
S DG300=$S($D(^DGPT(PTF,"S",S(DGZS0,1),300)):^(300),1:"") D:DG300]"" PRN3^DGPTFM8 K DG300
W !!
JUMP F I=$Y:1:19 W !
X S DGNUM=$S($D(S(DGZS0+1)):401_"-"_(DGZS0+1),1:"MAS") G 401^DGPTFJC:DGST
W "Enter <RET> to continue, 1-2 to edit,",!,"'S' to add a Surgical segment, '^N' for screen N, or '^' to abort:<",DGNUM,">// " R X:DTIME K DGNUM G Q:X="^",NEXM:X="",^DGPTFJ:X?1"^".E,ADD:X="S"!(X="s")
X1 G PR:X<1!(X>2) S DR="[DG401]",DGJUMP=X,DGSUR=+S(DGZS0,1)
N ICDVDT,ICPTVDT
S (ICDVDT,ICPTVDT)=$S($D(PTF):$$GETDATE^ICDGTDRG(PTF),1:DT)
K DA S DIE="^DGPT(",(DGPTF,DA)=PTF D ^DIE K DA,DR,DA
D CHK401^DGPTSCAN K DGPTF,DGSUR D MOB G EN
PR W !,"Enter '^' to stop the display and edit of data",!,"'^N' to jump to screen #N (appears in upper right of screen '<N>'",!,"<RET> to continue on to the next screen or 1-2 to edit:"
W !?10,"1-Surgical information",!?10,"2-Surgical/Procedure Codes"
W !,"You may also enter any combination of the above, separated by commas(ex:1,3,5)",!
R !!,"Enter <RET>: ",X:DTIME G WR
Q
NEXM S DGZS0=DGZS0+1 G ^DGPTFM:'$D(S(DGZS0)) G EN
ADD K SUR S DGZS0=0 S:'$D(^DGPT(PTF,"S",0)) ^(0)="^45.01DA^^"
S DIC="^DGPT("_PTF_",""S"",",DIC(0)="QEALM",DA(1)=PTF D ^DIC G ^DGPTFM:+Y'>0!('$D(^DGPT(PTF,"S",+Y)))
D MOB I SU F I=1:1:SU S:S(I,1)=+Y DGZS0=I
G ^DGPTFM:'DGZS0 S SUR(DGZS0)=+Y,X="1,2" G X1
MOB K S,S1,S2 S I=0,S2=0 F I1=1:1 S I=$O(^DGPT(PTF,"S",I)) Q:'I S S(I1)=^(I,0),S(I1,1)=I I S(I1)']"" K S(I1) S I1=I1-1
S SU=I1-1 Q
Q G Q^DGPTF
Q
1 ;;.01;2;3;4;5;6;7
2 ;;8;9;10;11;12
Q
Z I 'DGN S Z=$S(IOST="C-QUME"&($L(DGVI)'=2):Z,1:"["_Z_"]") W @DGVI,Z,@DGVO
E W " "
Q
Z1 F I=1:1:(Z1-$L(Z)) S Z=Z_" "
W Z
DGPTFM5 ;ALB/MTK/ADL - PTF ENTRY/EDIT-3 ; 11 MAR 91 15:15
+1 ;;5.3;Registration;**510,606,1015**;Aug 13, 1993;Build 21
+2 ;;ADL;Update for CSV Project;;Mar 26, 2003
+3 ;
+4 SET DGZS0=DGZS0+1
EN IF '$DATA(S)
DO MOB
SET S(DGZS0,1)=$SELECT($DATA(S(DGZS0,1)):S(DGZS0,1),1:"")
IF S(DGZS0,1)=""
GOTO NEXM
SET (S1,S(DGZS0))=$SELECT($DATA(^DGPT(PTF,"S",S(DGZS0,1),0)):^DGPT(PTF,"S",S(DGZS0,1),0),1:"")
WR WRITE @IOF,HEAD,?72
SET Z="<401-"_DGZS0_">"
DO Z^DGPTFM
+1 SET L=+S(DGZS0)
SET Y=L
DO D^DGPTUTL
WRITE !!
SET Z=1
DO Z
WRITE "Date of Surg: "
SET Z=Y
SET Z1=28
DO Z1
WRITE "Chief Surg: "
SET L=";"_$PIECE(^DD(45.01,4,0),U,3)
SET L1=";"_$PIECE(S1,U,4)_":"
WRITE $PIECE($PIECE(L,L1,2),";",1)
+2 WRITE !," Anesth Tech: "
SET L=";"_$PIECE(^DD(45.01,6,0),U,3)
SET L1=";"_$PIECE(S1,U,6)_":"
WRITE $PIECE($PIECE(L,L1,2),";",1),?45,"First Asst: "
SET L=";"_$PIECE(^DD(45.01,5,0),U,3)
SET L1=";"_$PIECE(S1,U,5)_":"
WRITE $PIECE($PIECE(L,L1,2),";",1)
+3 WRITE !," Source of pay: "
SET L=";"_$PIECE(^DD(45.01,7,0),U,3)
SET L1=";"_$PIECE(S1,U,7)_":"
WRITE $PIECE($PIECE(L,L1,2),";",1)
+4 WRITE ?46,"Surg spec: ",$EXTRACT($SELECT($DATA(^DIC(45.3,+$PIECE(S1,U,3),0)):$PIECE(^(0),U,2),1:""),1,23)
+5 WRITE !!
SET Z=2
DO Z
WRITE " Surg/pro: "
FOR I=1:1:5
SET L=$PIECE(S1,U,I+7)
IF L'=""
SET DGPTTMP=$$ICDOP^ICDCODE(+L,$$GETDATE^ICDGTDRG(PTF))
Begin DoDot:1
+6 WRITE $SELECT(+DGPTTMP>0&($PIECE(DGPTTMP,U,10)):$PIECE(DGPTTMP,U,5)_" ("_$PIECE(DGPTTMP,U,2)_")",1:"**********-"_L),!?17
End DoDot:1
+7 ;-- kidney transplant source
+8 SET DG300=$SELECT($DATA(^DGPT(PTF,"S",S(DGZS0,1),300)):^(300),1:"")
IF DG300]""
DO PRN3^DGPTFM8
KILL DG300
+9 WRITE !!
JUMP FOR I=$Y:1:19
WRITE !
X SET DGNUM=$SELECT($DATA(S(DGZS0+1)):401_"-"_(DGZS0+1),1:"MAS")
IF DGST
GOTO 401^DGPTFJC
+1 WRITE "Enter <RET> to continue, 1-2 to edit,",!,"'S' to add a Surgical segment, '^N' for screen N, or '^' to abort:<",DGNUM,">// "
READ X:DTIME
KILL DGNUM
IF X="^"
GOTO Q
IF X=""
GOTO NEXM
IF X?1"^".E
GOTO ^DGPTFJ
IF X="S"!(X="s")
GOTO ADD
X1 IF X<1!(X>2)
GOTO PR
SET DR="[DG401]"
SET DGJUMP=X
SET DGSUR=+S(DGZS0,1)
+1 NEW ICDVDT,ICPTVDT
+2 SET (ICDVDT,ICPTVDT)=$SELECT($DATA(PTF):$$GETDATE^ICDGTDRG(PTF),1:DT)
+3 KILL DA
SET DIE="^DGPT("
SET (DGPTF,DA)=PTF
DO ^DIE
KILL DA,DR,DA
+4 DO CHK401^DGPTSCAN
KILL DGPTF,DGSUR
DO MOB
GOTO EN
PR WRITE !,"Enter '^' to stop the display and edit of data",!,"'^N' to jump to screen #N (appears in upper right of screen '<N>'",!,"<RET> to continue on to the next screen or 1-2 to edit:"
+1 WRITE !?10,"1-Surgical information",!?10,"2-Surgical/Procedure Codes"
+2 WRITE !,"You may also enter any combination of the above, separated by commas(ex:1,3,5)",!
+3 READ !!,"Enter <RET>: ",X:DTIME
GOTO WR
+4 QUIT
NEXM SET DGZS0=DGZS0+1
IF '$DATA(S(DGZS0))
GOTO ^DGPTFM
GOTO EN
ADD KILL SUR
SET DGZS0=0
IF '$DATA(^DGPT(PTF,"S",0))
SET ^(0)="^45.01DA^^"
+1 SET DIC="^DGPT("_PTF_",""S"","
SET DIC(0)="QEALM"
SET DA(1)=PTF
DO ^DIC
IF +Y'>0!('$DATA(^DGPT(PTF,"S",+Y)))
GOTO ^DGPTFM
+2 DO MOB
IF SU
FOR I=1:1:SU
IF S(I,1)=+Y
SET DGZS0=I
+3 IF 'DGZS0
GOTO ^DGPTFM
SET SUR(DGZS0)=+Y
SET X="1,2"
GOTO X1
MOB KILL S,S1,S2
SET I=0
SET S2=0
FOR I1=1:1
SET I=$ORDER(^DGPT(PTF,"S",I))
IF 'I
QUIT
SET S(I1)=^(I,0)
SET S(I1,1)=I
IF S(I1)']""
KILL S(I1)
SET I1=I1-1
+1 SET SU=I1-1
QUIT
Q GOTO Q^DGPTF
+1 QUIT
1 ;;.01;2;3;4;5;6;7
2 ;;8;9;10;11;12
+1 QUIT
Z IF 'DGN
SET Z=$SELECT(IOST="C-QUME"&($LENGTH(DGVI)'=2):Z,1:"["_Z_"]")
WRITE @DGVI,Z,@DGVO
+1 IF '$TEST
WRITE " "
+2 QUIT
Z1 FOR I=1:1:(Z1-$LENGTH(Z))
SET Z=Z_" "
+1 WRITE Z
