- DVBCADEX ;ALB/GTS - 557/THM-ADD C&P EXAMS TO REQUESTS, PART 1 ; 6/28/91 9:32 AM
- ;;2.7;AMIE;**184,193**;Apr 10, 1995;Build 84
- ;
- N FF,HD,HD1,HD2,HD3
- SETUP D HOME^%ZIS S FF=IOF,HD="Add a C & P Exam for",HD1="Veteran Selection",HD2="Exam selection",HD3="2507 Exam Addition"
- ;
- EN ; Entry point
- N DVBCARY,DVBCRDAT,DVBCSITE
- K DVBCLCKD D KILL W @FF,!?(IOM-$L(HD3)\2),HD3,!!?(IOM-$L(HD1)\2),HD1,!!!
- S DIC(0)="AEQM",DIC="^DVB(396.3,",DIC("A")="Select VETERAN NAME: "
- S DIC("W")="D DICW^DVBCUTIL"
- S:$D(DVBAROUS) DIC("S")="I $P(^(0),U,10)'=""E""" ;**DVBAROUS set by menu
- D ^DIC G:X=""!(X=U) EXIT
- S:+Y>0 EXCNT=0,(DA,REQDA)=+Y,DFN=$P(Y,U,2) I +Y<0 W " ???",*7 H 1 G EN
- S X=^DVB(396.3,REQDA,0),OWNDOM=$P(X,U,22)
- D GETS^DIQ(396.3,REQDA,"1;2","E","DVBCARY")
- S DVBCRDAT=DVBCARY(396.3,REQDA_",",1,"E")
- S DVBCSITE=DVBCARY(396.3,REQDA_",",2,"E")
- I OWNDOM]"" W *7,!!,"This request is a TRANSFER IN and exams cannot be added.",!! H 3 G EN
- ;AJF;Request Status conversion
- S STAT=$$RSTAT^DVBCUTL8($P(X,U,18)) K NCN
- F DTB="X","RX","T","C","R","CT","NT" I STAT=DTB S NCN=1 Q
- I $D(NCN) W !!,*7,"This request has been ",$S(STAT["X":"cancelled",STAT="T":"transcribed",STAT["C":"completed",STAT="R":"released",STAT="NT":"transferred in",1:"given an incorrect status"),".",!! H 3 G EN
- S DTA=^DPT(DFN,0),PNAM=$P(DTA,U,1),SSN=$P(DTA,U,9),CNUM=$S($D(^DPT(DFN,.31)):$P(^(.31),U,3),1:"Unknown") S:CNUM="" CNUM="Unknown" D HDR,^DVBCEEXM W !!,"Press RETURN " R ANS:DTIME G:'$T EXIT
- D ^DVBCADE2,KILL G:$D(OUT)!($D(DVBCLCKD)) EXIT
- G EN
- ;
- EXIT K DVBCLCKD G KILL^DVBCUTIL
- ;
- HDR W @FF,?(IOM-$L(HD)\2),HD,!!,"Veteran name: ",$P(PNAM,",",2,99)," ",$P(PNAM,",",1),?55,"SSN: ",SSN,!?53,"C-NUM: ",CNUM,!
- F LINE=1:1:IOM W "="
- W ! Q
- ;
- KILL K CNUM,DFN,DIK,DR,DTA,DXCOD,DXNUM,EDIT,EX,EXMNM,FMT,PNAM,SSN,PCT,SC,REQDA,CTIM,VX,JY,JJ,X,%,^TMP($J),Y,DA,DIC,DIE,ANS,%Y,%,DTOUT,DUOUT,TEMP,DVBCCONT
- K DVBAINDA,DVBCARY,DVBCRDAT,DVBCSITE,DTB,DVBAROUS,EXCNT
- K LINE,OUT,OWNDOM,STAT
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBCADEX 1994 printed Feb 18, 2025@23:09:46 Page 2
- DVBCADEX ;ALB/GTS - 557/THM-ADD C&P EXAMS TO REQUESTS, PART 1 ; 6/28/91 9:32 AM
- +1 ;;2.7;AMIE;**184,193**;Apr 10, 1995;Build 84
- +2 ;
- +3 NEW FF,HD,HD1,HD2,HD3
- SETUP DO HOME^%ZIS
- SET FF=IOF
- SET HD="Add a C & P Exam for"
- SET HD1="Veteran Selection"
- SET HD2="Exam selection"
- SET HD3="2507 Exam Addition"
- +1 ;
- EN ; Entry point
- +1 NEW DVBCARY,DVBCRDAT,DVBCSITE
- +2 KILL DVBCLCKD
- DO KILL
- WRITE @FF,!?(IOM-$LENGTH(HD3)\2),HD3,!!?(IOM-$LENGTH(HD1)\2),HD1,!!!
- +3 SET DIC(0)="AEQM"
- SET DIC="^DVB(396.3,"
- SET DIC("A")="Select VETERAN NAME: "
- +4 SET DIC("W")="D DICW^DVBCUTIL"
- +5 ;**DVBAROUS set by menu
- if $DATA(DVBAROUS)
- SET DIC("S")="I $P(^(0),U,10)'=""E"""
- +6 DO ^DIC
- if X=""!(X=U)
- GOTO EXIT
- +7 if +Y>0
- SET EXCNT=0
- SET (DA,REQDA)=+Y
- SET DFN=$PIECE(Y,U,2)
- IF +Y<0
- WRITE " ???",*7
- HANG 1
- GOTO EN
- +8 SET X=^DVB(396.3,REQDA,0)
- SET OWNDOM=$PIECE(X,U,22)
- +9 DO GETS^DIQ(396.3,REQDA,"1;2","E","DVBCARY")
- +10 SET DVBCRDAT=DVBCARY(396.3,REQDA_",",1,"E")
- +11 SET DVBCSITE=DVBCARY(396.3,REQDA_",",2,"E")
- +12 IF OWNDOM]""
- WRITE *7,!!,"This request is a TRANSFER IN and exams cannot be added.",!!
- HANG 3
- GOTO EN
- +13 ;AJF;Request Status conversion
- +14 SET STAT=$$RSTAT^DVBCUTL8($PIECE(X,U,18))
- KILL NCN
- +15 FOR DTB="X","RX","T","C","R","CT","NT"
- IF STAT=DTB
- SET NCN=1
- QUIT
- +16 IF $DATA(NCN)
- WRITE !!,*7,"This request has been ",$SELECT(STAT["X":"cancelled",STAT="T":"transcribed",STAT["C":"completed",STAT="R":"released",STAT="NT":"transferred in",1:"given an incorrect status"),".",!!
- HANG 3
- GOTO EN
- +17 SET DTA=^DPT(DFN,0)
- SET PNAM=$PIECE(DTA,U,1)
- SET SSN=$PIECE(DTA,U,9)
- SET CNUM=$SELECT($DATA(^DPT(DFN,.31)):$PIECE(^(.31),U,3),1:"Unknown")
- if CNUM=""
- SET CNUM="Unknown"
- DO HDR
- DO ^DVBCEEXM
- WRITE !!,"Press RETURN "
- READ ANS:DTIME
- if '$TEST
- GOTO EXIT
- +18 DO ^DVBCADE2
- DO KILL
- if $DATA(OUT)!($DATA(DVBCLCKD))
- GOTO EXIT
- +19 GOTO EN
- +20 ;
- EXIT KILL DVBCLCKD
- GOTO KILL^DVBCUTIL
- +1 ;
- HDR WRITE @FF,?(IOM-$LENGTH(HD)\2),HD,!!,"Veteran name: ",$PIECE(PNAM,",",2,99)," ",$PIECE(PNAM,",",1),?55,"SSN: ",SSN,!?53,"C-NUM: ",CNUM,!
- +1 FOR LINE=1:1:IOM
- WRITE "="
- +2 WRITE !
- QUIT
- +3 ;
- KILL KILL CNUM,DFN,DIK,DR,DTA,DXCOD,DXNUM,EDIT,EX,EXMNM,FMT,PNAM,SSN,PCT,SC,REQDA,CTIM,VX,JY,JJ,X,%,^TMP($JOB),Y,DA,DIC,DIE,ANS,%Y,%,DTOUT,DUOUT,TEMP,DVBCCONT
- +1 KILL DVBAINDA,DVBCARY,DVBCRDAT,DVBCSITE,DTB,DVBAROUS,EXCNT
- +2 KILL LINE,OUT,OWNDOM,STAT
- +3 QUIT