NURAED3 ;HIRMFO/RM,MD,FT-HELP ROUTINE FOR NURSING DATA ;8/9/96 12:33
;;4.0;NURSING SERVICE;**32**;Apr 25, 1997
EN1 ; ENTRY TO GIVE XECUTABLE HELP FOR NAT. CERT FIELD OF 210 FILE
Q:'$D(^NURSF(210,D0,12,0))!(DA=D0)
D EN^DDIOL("CURRENT ENTRY IS : ")
I $D(^NURSF(210,D0,12,DA,0)),$P(^(0),U)'="",$D(^NURSF(212.2,$P(^NURSF(210,D0,12,DA,0),U),0)) S Z=DA D A,EN^DDIOL("","","!!!")
Q
A I $D(^NURSF(210,D0,12,Z,0)),$P(^(0),U)'="",$D(^NURSF(212.2,$P(^NURSF(210,D0,12,Z,0),U),0)) D EN^DDIOL(Z_" "_$P(^(0),"^")_" "_$P(^(0),"^",2)_" "_$P(^(0),"^",3),"","!?3")
Q
EN2 ; THIS ENTRY POINT IS UTILIZED BY ALL PRINT ROUTINES WITH SUB-TOTALS
S (NTOT,NTCT)=0 I NRPT=3 D
.S X=0 F S X=$O(^TMP("NURA",$J,X)) Q:X'>0 S NTOT=NTOT+1 S Y=0 F S Y=$O(^TMP("NURA",$J,X,Y)) Q:Y'>0 S NTCT=NTCT+1
E D
.S (V,W,X,Y,Z)=""
.F S V=$O(^TMP("NURA",$J,V)) Q:V="" F S W=$O(^TMP("NURA",$J,V,W)) Q:W="" F S X=$O(^TMP("NURA",$J,V,W,X)) Q:X'>0 S NTOT=NTOT+1 F S Y=$O(^TMP("NURA",$J,V,W,X,Y)) Q:Y'>0 F S Z=$O(^TMP("NURA",$J,V,W,X,Y,Z)) Q:Z'>0 S NTCT=NTCT+1
.Q
Q
EN3 ; ENTRY FROM NURS-I-STAFF1 TEMPLATE
; THE NURSS, SAVEADD, SAVEADD2, SAVEADD3, SAVEZIP, SAVECITY, SAVESTAT
; VARIABLES ARE KILLED OFF IN THE NURS-I-STAFF1 TEMPLATE
D GETNODE S NURSS=$S('$D(^VA(200,ID,.11)):0,1:1),SAVEADD=$S('NURSS:"",1:$P(^(.11),"^",1)),SAVEADD2=$S('NURSS:"",1:$P(^(.11),"^",2)),SAVEADD3=$S('NURSS:"",1:$P(^(.11),"^",3)),SAVEZIP=$S('NURSS:"",1:$P(^(.11),"^",6))
S SAVECITY=$S('NURSS:"",1:$P(^VA(200,ID,.11),"^",4)),SAVESTAT=$S('NURSS:"",$P(^VA(200,ID,.11),"^",5)="":"",'$D(^DIC(5,$P(^VA(200,ID,.11),"^",5),0)):"",1:$P(^(0),"^",1))
F NURSI=1:1:6 S NURSVAR=$S(NURSI=1:"SAVEADD",NURSI=2:"SAVEADD2",NURSI=3:"SAVEADD3",NURSI=4:"SAVECITY",NURSI=5:"SAVESTAT",1:"SAVEZIP") I @NURSVAR="" S $P(^NURSF(210,DA,15),"^",NURSI)=""
K NURSVAR,NURSI,ID
Q
EN4 ; VARIABLES N1,NFCNT,NMCNT,NTCT,NTOT ARE KILLED BY CALLING ROUTINE
S (NX,NTOT)=0 F S NX=$O(^TMP("NURA",$J,NX)) Q:NX="" S NTOT=NTOT+1
S (NMCNT,NMCNT(1),NFCNT,NFCNT(1),NTCT,NX)=0
F S NX=$O(^TMP("NURA",$J,NX)) Q:NX="" S NY="" F S NY=$O(^TMP("NURA",$J,NX,NY)) Q:NY="" S:NY="M" NMCNT=NMCNT+1,NMCNT(1)=NMCNT(1)+1 S:NY="F" NFCNT=NFCNT+1,NFCNT(1)=NFCNT(1)+1 S NZ=0 F S NZ=$O(^TMP("NURA",$J,NX,NY,NZ)) Q:NZ'>0 S NTCT=NTCT+1
K NX,NY,NZ Q
GETNODE ; OBTAIN POINTER TO VA(200
S ID=$P(^NURSF(210,+NURSDBA,0),"^")
Q
EN5 ; POSITION EDIT AS IDENTIFIER FOR STAFF ENTRY
S NUROUT=0,NURSASS(1)="",NURSPOS(1)="^^^"_NUR200_"^^^^^^^1"
STDT ; SELECT START DATE
R !?3,"PRIMARY POSITION START DATE: ",X:DTIME I '$T!(X?1"^".E) S NUROUT=1 G Q5
I X="" W !?3,$C(7),"Required!!" G STDT
I X?1"?".E W $C(7),!?3,"Answer with the starting date for the primary position."
S %DT="E" D ^%DT I +Y'>0 W:X'?1"?".E $C(7)," ??" G STDT
S $P(NURSPOS(1),"^",3)=+Y
LOCN ; SELECT LOCATION
R !?3,"PRIMARY DUTY LOCATION: ",X:DTIME I '$T!(X?1"^".E) S NUROUT=1 G Q5
I X="" W !?3,$C(7),"Required!!" G LOCN
S DIC=211.4,DIC(0)="QMEZ" D ^DIC K DIC I +Y'>0 G LOCN
S $P(NURSPOS(1),"^")=$P(Y,"^",2)
SPON ; SELECT SERVICE POSITION
R !?3,"PRIMARY SERVICE POSITION: ",X:DTIME I '$T!(X?1"^".E) S NUROUT=1 G Q5
I X="" W !?3,$C(7),"Required!!" G STDT
S DIC=211.3,DIC(0)="QMEZ" D ^DIC K DIC I +Y'>0 G SPON
S $P(NURSPOS(1),"^",2)=$P(Y(0),"^",5),$P(NURSPOS(1),"^",5)=+Y
Q5 ;
I '$G(NUROUT) D EN2^NURAED6
I $G(NUROUT) W !?3,$C(7),"No position data stored!!"
K %DT,DIC,NUROUT,NURSASS,NURSPOS
Q
EN6 ;XECUTABLE HELP FOR EXPERIENCE FIELD OF 210 FILE
S NURSLO=$S($D(^NURSF(210,D0,20,+Y,0)):^(0),1:"") D DICW
K NURSLO D EN^DDIOL($E(@(DIC_Y_",0)"),0),"","?0")
Q
DICW ; EXECTUTED BY DIC("W") STRING IN PROFESSIONAL EXPERIENCE LOOKUP FROM
; PROFESSIONAL EXPERIENCE [NURAED-STF-EXP] OPTION.
I $P(NURSLO,U)'="" D
. S NURSLO(1)=$P(NURSLO,U),NURSLO(1,"F")="?5"
. S NURSLO(2)=$P(NURSLO,U,4),NURSLO(2,"F")="?32"
. Q
I +$E($P(NURSLO,U,5),1,3)>0 D
. S NURSLO(3)=$E($P(NURSLO,U,5),2,3),NURSLO(3,"F")="?63"
. Q
I +$E($P(NURSLO,U,6),1,3)>0 D
. S NURSLO(4)=" to "_$E($P(NURSLO,U,6),2,3),NURSLO(4,"F")="?65"
. Q
S NURSLO(5)="",NURSLO(5,"F")="!"
D:$G(NURSLO(1))'="" EN^DDIOL(.NURSLO)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURAED3 4139 printed Oct 16, 2024@18:20 Page 2
NURAED3 ;HIRMFO/RM,MD,FT-HELP ROUTINE FOR NURSING DATA ;8/9/96 12:33
+1 ;;4.0;NURSING SERVICE;**32**;Apr 25, 1997
EN1 ; ENTRY TO GIVE XECUTABLE HELP FOR NAT. CERT FIELD OF 210 FILE
+1 if '$DATA(^NURSF(210,D0,12,0))!(DA=D0)
QUIT
+2 DO EN^DDIOL("CURRENT ENTRY IS : ")
+3 IF $DATA(^NURSF(210,D0,12,DA,0))
IF $PIECE(^(0),U)'=""
IF $DATA(^NURSF(212.2,$PIECE(^NURSF(210,D0,12,DA,0),U),0))
SET Z=DA
DO A
DO EN^DDIOL("","","!!!")
+4 QUIT
A IF $DATA(^NURSF(210,D0,12,Z,0))
IF $PIECE(^(0),U)'=""
IF $DATA(^NURSF(212.2,$PIECE(^NURSF(210,D0,12,Z,0),U),0))
DO EN^DDIOL(Z_" "_$PIECE(^(0),"^")_" "_$PIECE(^(0),"^",2)_" "_$PIECE(^(0),"^",3),"","!?3")
+1 QUIT
EN2 ; THIS ENTRY POINT IS UTILIZED BY ALL PRINT ROUTINES WITH SUB-TOTALS
+1 SET (NTOT,NTCT)=0
IF NRPT=3
Begin DoDot:1
+2 SET X=0
FOR
SET X=$ORDER(^TMP("NURA",$JOB,X))
if X'>0
QUIT
SET NTOT=NTOT+1
SET Y=0
FOR
SET Y=$ORDER(^TMP("NURA",$JOB,X,Y))
if Y'>0
QUIT
SET NTCT=NTCT+1
End DoDot:1
+3 IF '$TEST
Begin DoDot:1
+4 SET (V,W,X,Y,Z)=""
+5 FOR
SET V=$ORDER(^TMP("NURA",$JOB,V))
if V=""
QUIT
FOR
SET W=$ORDER(^TMP("NURA",$JOB,V,W))
if W=""
QUIT
FOR
SET X=$ORDER(^TMP("NURA",$JOB,V,W,X))
if X'>0
QUIT
SET NTOT=NTOT+1
FOR
SET Y=$ORDER(^TMP("NURA",$JOB,V,W,X,Y))
if Y'>0
QUIT
FOR
SET Z=$ORDER(^TMP("NURA",$JOB,V,W,X,Y,Z))
if Z'>0
QUIT
SET NTCT=NTCT+1
+6 QUIT
End DoDot:1
+7 QUIT
EN3 ; ENTRY FROM NURS-I-STAFF1 TEMPLATE
+1 ; THE NURSS, SAVEADD, SAVEADD2, SAVEADD3, SAVEZIP, SAVECITY, SAVESTAT
+2 ; VARIABLES ARE KILLED OFF IN THE NURS-I-STAFF1 TEMPLATE
+3 DO GETNODE
SET NURSS=$SELECT('$DATA(^VA(200,ID,.11)):0,1:1)
SET SAVEADD=$SELECT('NURSS:"",1:$PIECE(^(.11),"^",1))
SET SAVEADD2=$SELECT('NURSS:"",1:$PIECE(^(.11),"^",2))
SET SAVEADD3=$SELECT('NURSS:"",1:$PIECE(^(.11),"^",3))
SET SAVEZIP=$SELECT('NURSS:"",1:$PIECE(^(.11),"^",6))
+4 SET SAVECITY=$SELECT('NURSS:"",1:$PIECE(^VA(200,ID,.11),"^",4))
SET SAVESTAT=$SELECT('NURSS:"",$PIECE(^VA(200,ID,.11),"^",5)="":"",'$DATA(^DIC(5,$PIECE(^VA(200,ID,.11),"^",5),0)):"",1:$PIECE(^(0),"^",1))
+5 FOR NURSI=1:1:6
SET NURSVAR=$SELECT(NURSI=1:"SAVEADD",NURSI=2:"SAVEADD2",NURSI=3:"SAVEADD3",NURSI=4:"SAVECITY",NURSI=5:"SAVESTAT",1:"SAVEZIP")
IF @NURSVAR=""
SET $PIECE(^NURSF(210,DA,15),"^",NURSI)=""
+6 KILL NURSVAR,NURSI,ID
+7 QUIT
EN4 ; VARIABLES N1,NFCNT,NMCNT,NTCT,NTOT ARE KILLED BY CALLING ROUTINE
+1 SET (NX,NTOT)=0
FOR
SET NX=$ORDER(^TMP("NURA",$JOB,NX))
if NX=""
QUIT
SET NTOT=NTOT+1
+2 SET (NMCNT,NMCNT(1),NFCNT,NFCNT(1),NTCT,NX)=0
+3 FOR
SET NX=$ORDER(^TMP("NURA",$JOB,NX))
if NX=""
QUIT
SET NY=""
FOR
SET NY=$ORDER(^TMP("NURA",$JOB,NX,NY))
if NY=""
QUIT
if NY="M"
SET NMCNT=NMCNT+1
SET NMCNT(1)=NMCNT(1)+1
if NY="F"
SET NFCNT=NFCNT+1
SET NFCNT(1)=NFCNT(1)+1
SET NZ=0
FOR
SET NZ=$ORDER(^TMP("NURA",$JOB,NX,NY,NZ))
if NZ'>0
QUIT
SET NTCT=NTCT+1
+4 KILL NX,NY,NZ
QUIT
GETNODE ; OBTAIN POINTER TO VA(200
+1 SET ID=$PIECE(^NURSF(210,+NURSDBA,0),"^")
+2 QUIT
EN5 ; POSITION EDIT AS IDENTIFIER FOR STAFF ENTRY
+1 SET NUROUT=0
SET NURSASS(1)=""
SET NURSPOS(1)="^^^"_NUR200_"^^^^^^^1"
STDT ; SELECT START DATE
+1 READ !?3,"PRIMARY POSITION START DATE: ",X:DTIME
IF '$TEST!(X?1"^".E)
SET NUROUT=1
GOTO Q5
+2 IF X=""
WRITE !?3,$CHAR(7),"Required!!"
GOTO STDT
+3 IF X?1"?".E
WRITE $CHAR(7),!?3,"Answer with the starting date for the primary position."
+4 SET %DT="E"
DO ^%DT
IF +Y'>0
if X'?1"?".E
WRITE $CHAR(7)," ??"
GOTO STDT
+5 SET $PIECE(NURSPOS(1),"^",3)=+Y
LOCN ; SELECT LOCATION
+1 READ !?3,"PRIMARY DUTY LOCATION: ",X:DTIME
IF '$TEST!(X?1"^".E)
SET NUROUT=1
GOTO Q5
+2 IF X=""
WRITE !?3,$CHAR(7),"Required!!"
GOTO LOCN
+3 SET DIC=211.4
SET DIC(0)="QMEZ"
DO ^DIC
KILL DIC
IF +Y'>0
GOTO LOCN
+4 SET $PIECE(NURSPOS(1),"^")=$PIECE(Y,"^",2)
SPON ; SELECT SERVICE POSITION
+1 READ !?3,"PRIMARY SERVICE POSITION: ",X:DTIME
IF '$TEST!(X?1"^".E)
SET NUROUT=1
GOTO Q5
+2 IF X=""
WRITE !?3,$CHAR(7),"Required!!"
GOTO STDT
+3 SET DIC=211.3
SET DIC(0)="QMEZ"
DO ^DIC
KILL DIC
IF +Y'>0
GOTO SPON
+4 SET $PIECE(NURSPOS(1),"^",2)=$PIECE(Y(0),"^",5)
SET $PIECE(NURSPOS(1),"^",5)=+Y
Q5 ;
+1 IF '$GET(NUROUT)
DO EN2^NURAED6
+2 IF $GET(NUROUT)
WRITE !?3,$CHAR(7),"No position data stored!!"
+3 KILL %DT,DIC,NUROUT,NURSASS,NURSPOS
+4 QUIT
EN6 ;XECUTABLE HELP FOR EXPERIENCE FIELD OF 210 FILE
+1 SET NURSLO=$SELECT($DATA(^NURSF(210,D0,20,+Y,0)):^(0),1:"")
DO DICW
+2 KILL NURSLO
DO EN^DDIOL($EXTRACT(@(DIC_Y_",0)"),0),"","?0")
+3 QUIT
DICW ; EXECTUTED BY DIC("W") STRING IN PROFESSIONAL EXPERIENCE LOOKUP FROM
+1 ; PROFESSIONAL EXPERIENCE [NURAED-STF-EXP] OPTION.
+2 IF $PIECE(NURSLO,U)'=""
Begin DoDot:1
+3 SET NURSLO(1)=$PIECE(NURSLO,U)
SET NURSLO(1,"F")="?5"
+4 SET NURSLO(2)=$PIECE(NURSLO,U,4)
SET NURSLO(2,"F")="?32"
+5 QUIT
End DoDot:1
+6 IF +$EXTRACT($PIECE(NURSLO,U,5),1,3)>0
Begin DoDot:1
+7 SET NURSLO(3)=$EXTRACT($PIECE(NURSLO,U,5),2,3)
SET NURSLO(3,"F")="?63"
+8 QUIT
End DoDot:1
+9 IF +$EXTRACT($PIECE(NURSLO,U,6),1,3)>0
Begin DoDot:1
+10 SET NURSLO(4)=" to "_$EXTRACT($PIECE(NURSLO,U,6),2,3)
SET NURSLO(4,"F")="?65"
+11 QUIT
End DoDot:1
+12 SET NURSLO(5)=""
SET NURSLO(5,"F")="!"
+13 if $GET(NURSLO(1))'=""
DO EN^DDIOL(.NURSLO)
+14 QUIT
